5 |
|
|
6 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
7 |
|
|
|
C SUBROUTINE MNC_CW_W_RL( |
|
|
C I myThid, myIter, |
|
|
C I filebn, |
|
|
C I bi,bj, |
|
|
C I Gtype, |
|
|
C I Rtype, |
|
|
C I vname, |
|
|
C I var ) |
|
|
|
|
|
C implicit none |
|
|
C #include "netcdf.inc" |
|
|
C #include "mnc_common.h" |
|
|
C #include "EEPARAMS.h" |
|
|
|
|
|
C C Arguments |
|
|
C integer myThid, myIter, bi,bj |
|
|
C character*(*) filebn, Gtype |
|
|
C character*(2) Rtype |
|
|
C _RL var*(*) |
|
|
|
|
|
|
|
|
|
|
|
C RETURN |
|
|
C END |
|
|
|
|
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
|
|
|
|
8 |
SUBROUTINE MNC_CW_ADD_GNAME( |
SUBROUTINE MNC_CW_ADD_GNAME( |
9 |
I myThid, |
I myThid, |
10 |
I name, |
I name, |
71 |
C Local Variables |
C Local Variables |
72 |
integer i,j, ntot |
integer i,j, ntot |
73 |
|
|
74 |
|
write(*,'(a)') 'The currently defined Grid Types are:' |
75 |
ntot = 0 |
ntot = 0 |
76 |
DO j = 1,MNC_MAX_ID |
DO j = 1,MNC_MAX_ID |
77 |
IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR) |
IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR) |
84 |
& ' | ', (mnc_cw_is(i,j), i=1,5), |
& ' | ', (mnc_cw_is(i,j), i=1,5), |
85 |
& ' | ', (mnc_cw_ie(i,j), i=1,5), |
& ' | ', (mnc_cw_ie(i,j), i=1,5), |
86 |
& ' | ', (mnc_cw_dn(i,j)(1:4), i=1,5) |
& ' | ', (mnc_cw_dn(i,j)(1:4), i=1,5) |
|
|
|
87 |
|
|
88 |
ENDIF |
ENDIF |
89 |
ENDDO |
ENDDO |
90 |
|
|
91 |
|
write(*,'(a)') 'The currently defined Variable Types are:' |
92 |
|
ntot = 0 |
93 |
|
DO j = 1,MNC_MAX_ID |
94 |
|
IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR) |
95 |
|
& .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN |
96 |
|
|
97 |
|
ntot = ntot + 1 |
98 |
|
write(*,'(2i5,a3,a25,a3,i4)') j, ntot, ' : ', |
99 |
|
& mnc_cw_vname(j)(1:20), ' : ', mnc_cw_vgind(j) |
100 |
|
|
101 |
|
DO i = 1,mnc_cw_vnat(1,j) |
102 |
|
write(*,'(a14,i4,a3,a25,a3,a25)') ' text_at:',i, |
103 |
|
& ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ', |
104 |
|
& mnc_cw_vtat(i,j)(1:25) |
105 |
|
ENDDO |
106 |
|
DO i = 1,mnc_cw_vnat(2,j) |
107 |
|
write(*,'(a14,i4,a3,a25,a3,i20)') ' int__at:',i, |
108 |
|
& ' : ', mnc_cw_vinm(i,j)(1:25), ' : ', |
109 |
|
& mnc_cw_viat(i,j) |
110 |
|
ENDDO |
111 |
|
DO i = 1,mnc_cw_vnat(3,j) |
112 |
|
write(*,'(a14,i4,a3,a25,a3,f25.10)') ' dbl__at:',i, |
113 |
|
& ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ', |
114 |
|
& mnc_cw_vdat(i,j) |
115 |
|
ENDDO |
116 |
|
|
117 |
|
ENDIF |
118 |
|
ENDDO |
119 |
|
IF (ntot .EQ. 0) THEN |
120 |
|
write(*,'(a)') ' None defined!' |
121 |
|
ENDIF |
122 |
|
|
123 |
|
|
124 |
RETURN |
RETURN |
125 |
END |
END |
126 |
|
|
366 |
CALL print_error(msgbuf, mythid) |
CALL print_error(msgbuf, mythid) |
367 |
stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME' |
stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME' |
368 |
ENDIF |
ENDIF |
|
CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_gname, |
|
|
& indg) |
|
369 |
|
|
370 |
mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR) |
mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR) |
371 |
mnc_cw_vname(indv)(1:(nvl-nvf+1)) = vname(nvf:nvl) |
mnc_cw_vname(indv)(1:(nvl-nvf+1)) = vname(nvf:nvl) |
379 |
|
|
380 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
381 |
|
|
382 |
|
SUBROUTINE MNC_CW_ADD_VATTR_TEXT( |
383 |
|
I myThid, |
384 |
|
I vname, |
385 |
|
I ntat, |
386 |
|
I tnames, |
387 |
|
I tvals ) |
388 |
|
|
389 |
|
implicit none |
390 |
|
|
391 |
|
C Arguments |
392 |
|
integer myThid, ntat |
393 |
|
character*(*) vname, tnames(*), tvals(*) |
394 |
|
|
395 |
|
CALL MNC_CW_ADD_VATTR_ANY(myThid, vname, |
396 |
|
& ntat, 0, 0, |
397 |
|
& tnames, ' ', ' ', |
398 |
|
& tvals, 0, 0.0D0 ) |
399 |
|
|
400 |
|
RETURN |
401 |
|
END |
402 |
|
|
403 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
404 |
|
|
405 |
|
SUBROUTINE MNC_CW_ADD_VATTR_INT( |
406 |
|
I myThid, |
407 |
|
I vname, |
408 |
|
I niat, |
409 |
|
I inames, |
410 |
|
I ivals ) |
411 |
|
|
412 |
|
implicit none |
413 |
|
|
414 |
|
C Arguments |
415 |
|
integer myThid, niat |
416 |
|
character*(*) vname, inames(*) |
417 |
|
integer ivals(*) |
418 |
|
|
419 |
|
CALL MNC_CW_ADD_VATTR_ANY(myThid, vname, |
420 |
|
& 0, niat, 0, |
421 |
|
& ' ', inames, ' ', |
422 |
|
& ' ', ivals, 0.0D0 ) |
423 |
|
|
424 |
|
RETURN |
425 |
|
END |
426 |
|
|
427 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
428 |
|
|
429 |
|
SUBROUTINE MNC_CW_ADD_VATTR_DBL( |
430 |
|
I myThid, |
431 |
|
I vname, |
432 |
|
I ndat, |
433 |
|
I dnames, |
434 |
|
I dvals ) |
435 |
|
|
436 |
|
implicit none |
437 |
|
|
438 |
|
C Arguments |
439 |
|
integer myThid, ndat |
440 |
|
character*(*) vname, dnames(*) |
441 |
|
REAL*8 dvals(*) |
442 |
|
|
443 |
|
CALL MNC_CW_ADD_VATTR_ANY(myThid, vname, |
444 |
|
& 0, 0, ndat, |
445 |
|
& ' ', ' ', dnames, |
446 |
|
& ' ', 0, dvals ) |
447 |
|
|
448 |
|
RETURN |
449 |
|
END |
450 |
|
|
451 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
452 |
|
|
453 |
SUBROUTINE MNC_CW_ADD_VATTR_ANY( |
SUBROUTINE MNC_CW_ADD_VATTR_ANY( |
454 |
I myThid, |
I myThid, |
455 |
I vname, |
I vname, |
522 |
|
|
523 |
RETURN |
RETURN |
524 |
END |
END |
525 |
|
|
526 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
527 |
|
|
528 |
|
SUBROUTINE MNC_CW_GET_TILE_NUM( |
529 |
|
I myThid, |
530 |
|
I bi, bj, |
531 |
|
O uniq_tnum ) |
532 |
|
|
533 |
|
implicit none |
534 |
|
#include "EEPARAMS.h" |
535 |
|
#include "SIZE.h" |
536 |
|
|
537 |
|
C Arguments |
538 |
|
integer myThid, bi,bj, uniq_tnum |
539 |
|
|
540 |
|
C Local Variables |
541 |
|
integer iG,jG |
542 |
|
|
543 |
|
#ifdef ALLOW_EXCH2 |
544 |
|
|
545 |
|
#include "W2_EXCH2_PARAMS.h" |
546 |
|
uniq_tnum = W2_myTileList(bi) |
547 |
|
|
548 |
|
#else |
549 |
|
|
550 |
|
C Global tile number for simple (non-cube) domains |
551 |
|
iG = bi+(myXGlobalLo-1)/sNx |
552 |
|
jG = bj+(myYGlobalLo-1)/sNy |
553 |
|
C . full rows partial rows |
554 |
|
uniq_tnum = (jG - 1)*nPx*(nSx*nSy) + (iG - 1)*(nSx*nSy) |
555 |
|
|
556 |
|
#endif |
557 |
|
|
558 |
|
RETURN |
559 |
|
END |
560 |
|
|
561 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
562 |
|
|
563 |
|
SUBROUTINE MNC_CW_FILE_AORC( |
564 |
|
I myThid, |
565 |
|
I fname ) |
566 |
|
|
567 |
|
implicit none |
568 |
|
#include "netcdf.inc" |
569 |
|
#include "mnc_common.h" |
570 |
|
#include "EEPARAMS.h" |
571 |
|
|
572 |
|
C Arguments |
573 |
|
integer myThid |
574 |
|
character*(*) fname |
575 |
|
|
576 |
|
C Local Variables |
577 |
|
integer i, ierr, indf |
578 |
|
character*(MAX_LEN_MBUF) msgbuf |
579 |
|
|
580 |
|
C Check if the file is already open |
581 |
|
CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf) |
582 |
|
IF (indf .GT. 0) THEN |
583 |
|
RETURN |
584 |
|
ENDIF |
585 |
|
|
586 |
|
C Try to open an existing file |
587 |
|
CALL MNC_FILE_TRY_READ(myThid, fname, ierr) |
588 |
|
IF (ierr .EQ. NF_NOERR) THEN |
589 |
|
RETURN |
590 |
|
ENDIF |
591 |
|
|
592 |
|
C Try to create a new one |
593 |
|
|
594 |
|
|
595 |
|
RETURN |
596 |
|
END |
597 |
|
|
598 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
599 |
|
|