MITgcm |
|
|
|
|||
File indexing completed on 2018-03-02 18:36:15 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC548a795951 Jean*0001 #include "CPP_EEOPTIONS.h" 0002 0003 C-- File write_utils.F: Routine for formatted textual I/O to Standard Output 0004 C-- Contents 0005 C-- o WRITE_1D_I 0006 C-- o WRITE_1D_L 0007 C-- o WRITE_1D_RL 0008 C-- o WRITE_0D_I 0009 C-- o WRITE_0D_L 0010 C-- o WRITE_0D_R4 0011 C-- o WRITE_0D_R8 0012 C-- o WRITE_0D_RS 0013 C-- o WRITE_0D_RL 0014 C-- o WRITE_0D_C 0015 C-- o WRITE_COPY1D_R4 0016 C-- o WRITE_COPY1D_R8 0017 C-- o WRITE_COPY1D_RS 0018 C-- o WRITE_XY_XLINE_RS 0019 C-- o WRITE_XY_YLINE_RS 0020 0021 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0022 0023 CBOP 0024 C !ROUTINE: WRITE_1D_I 0025 C !INTERFACE: 0026 SUBROUTINE WRITE_1D_I( fld, lFld, index_type, head, comment ) 0027 0028 C !DESCRIPTION: \bv 0029 C *==========================================================* 0030 C | o SUBROUTINE WRITE_1D_I 0031 C | Controls formatted, tabular I/O for a one-dimensional 0032 C | INTEGER field. 0033 C *==========================================================* 0034 C | This routine produces a standard format for list 0035 C | one-dimensional INTEGER data in textual form. The format 0036 C | is designed to be readily parsed by a post-processing 0037 C | utility. 0038 C *==========================================================* 0039 C \ev 0040 0041 C !USES: 0042 IMPLICIT NONE 0043 C == Global data == 0044 #include "SIZE.h" 0045 #include "EEPARAMS.h" 0046 0047 C !INPUT/OUTPUT PARAMETERS: 0048 C == Routine arguments == 0049 C fld :: Field to be printed 0050 C lFld :: Number of elements (in field "fld") to print 0051 C index_type :: Type of index labelling (I=,J=,...) to use 0052 C head :: Statement start (e.g. phi = ) 0053 C comment :: Descriptive comment for field 0054 INTEGER lFld 0055 INTEGER fld(lFld) 0056 INTEGER index_type 0057 CHARACTER*(*) head 0058 CHARACTER*(*) comment 0059 0060 C !LOCAL VARIABLES: 0061 C == Local variables == 0062 CHARACTER*(MAX_LEN_MBUF) msgBuf 0063 CEOP 0064 0065 WRITE(msgBuf,'(A,A)') head, comment 0066 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0067 & SQUEEZE_RIGHT , 1) 0068 CALL PRINT_LIST_I( fld, 1, lFld, index_type, .FALSE., 0069 & .TRUE., standardMessageUnit ) 0070 WRITE(msgBuf,'(A)') ' ; ' 0071 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0072 & SQUEEZE_RIGHT , 1) 0073 0074 RETURN 0075 END 0076 0077 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0078 0079 CBOP 0080 C !ROUTINE: WRITE_1D_L 0081 C !INTERFACE: 0082 SUBROUTINE WRITE_1D_L( fld, lFld, index_type, head, comment ) 0083 0084 C !DESCRIPTION: \bv 0085 C *==========================================================* 0086 C | o SUBROUTINE WRITE_1D_L 0087 C | Controls formatted, tabular I/O for a one-dimensional 0088 C | LOGICAL field. 0089 C *==========================================================* 0090 C | This routine produces a standard format for list 0091 C | one-dimensional LOGICAL data in textual form. The format 0092 C | is designed to be readily parsed by a post-processing 0093 C | utility. 0094 C *==========================================================* 0095 C \ev 0096 0097 C !USES: 0098 IMPLICIT NONE 0099 C == Global data == 0100 #include "SIZE.h" 0101 #include "EEPARAMS.h" 0102 0103 C !INPUT/OUTPUT PARAMETERS: 0104 C == Routine arguments == 0105 C fld :: Field to be printed 0106 C lFld :: Number of elements (in field "fld") to print 0107 C index_type :: Type of index labelling (I=,J=,...) to use 0108 C head :: Statement start (e.g. phi = ) 0109 C comment :: Descriptive comment for field 0110 INTEGER lFld 0111 LOGICAL fld(lFld) 0112 INTEGER index_type 0113 CHARACTER*(*) head 0114 CHARACTER*(*) comment 0115 0116 C !LOCAL VARIABLES: 0117 C == Local variables == 0118 CHARACTER*(MAX_LEN_MBUF) msgBuf 0119 CEOP 0120 0121 WRITE(msgBuf,'(A,A)') head, comment 0122 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0123 & SQUEEZE_RIGHT , 1) 0124 CALL PRINT_LIST_L( fld, 1, lFld, index_type, .FALSE., 0125 & .TRUE., standardMessageUnit ) 0126 WRITE(msgBuf,'(A)') ' ; ' 0127 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0128 & SQUEEZE_RIGHT , 1) 0129 0130 RETURN 0131 END 0132 0133 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0134 0135 CBOP 0136 C !ROUTINE: WRITE_1D_RL 0137 C !INTERFACE: 0138 SUBROUTINE WRITE_1D_RL( fld, lFld, index_type, head, comment ) 0139 0140 C !DESCRIPTION: \bv 0141 C *==========================================================* 0142 C | o SUBROUTINE WRITE_1D_RL 0143 C | Controls formatted, tabular I/O for a one-dimensional 0144 C | "RL" type field. 0145 C *==========================================================* 0146 C | This routine produces a standard format for list 0147 C | one-dimensional real*8 data in textual form. The format 0148 C | is designed to be readily parsed by a post-processing 0149 C | utility. 0150 C *==========================================================* 0151 C \ev 0152 0153 C !USES: 0154 IMPLICIT NONE 0155 C == Global data == 0156 #include "SIZE.h" 0157 #include "EEPARAMS.h" 0158 EXTERNAL ILNBLNK 0159 INTEGER ILNBLNK 0160 0161 C !INPUT/OUTPUT PARAMETERS: 0162 C == Routine arguments == 0163 C fld :: Field to be printed 0164 C lFld :: Number of elements (in field "fld") to print 0165 C index_type :: Type of index labelling (I=,J=,...) to use 0166 C head :: Statement start (e.g. phi = ) 0167 C comment :: Descriptive comment for field 0168 INTEGER lFld 0169 _RL fld(lFld) 0170 INTEGER index_type 0171 CHARACTER*(*) head 0172 CHARACTER*(*) comment 0173 0174 C !LOCAL VARIABLES: 0175 C == Local variables == 0176 C ILH, ILC - Index of last balnk in head and comment 0177 CHARACTER*(MAX_LEN_MBUF) msgBuf 0178 INTEGER ILH, ILC 0179 INTEGER i, j, ic, i1, i2, nCount 0180 LOGICAL outpAll 0181 _RL prev 0182 CEOP 0183 0184 C- when list is long, try to write just few of them 0185 outpAll = .TRUE. 0186 IF ( ( index_type.EQ.INDEX_I .OR. index_type.EQ.INDEX_J ) 0187 & .AND. lFld.GT.maxLengthPrt1D ) THEN 0188 C- Count how many would be written 0189 nCount = 1 0190 prev = fld(1) 0191 DO i= 2,lFld 0192 IF ( fld(i).NE.prev ) nCount = nCount + 1 0193 prev = fld(i) 0194 ENDDO 0195 IF ( nCount.GT.maxLengthPrt1D ) outpAll = .FALSE. 0196 ENDIF 0197 ILH=ILNBLNK(head) 0198 ILC=ILNBLNK(comment) 0199 WRITE(msgBuf,'(A,A)') head(1:ILH), comment(1:ILC) 0200 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0201 & SQUEEZE_RIGHT , 1) 0202 IF ( outpAll ) THEN 0203 C- write all of them 0204 CALL PRINT_LIST_RL( fld, 1, lFld, index_type, .FALSE., 0205 & .TRUE., standardMessageUnit ) 0206 ELSE 0207 C- write just 5 sets of 5-6 consecutive values (truncate 1rst and last) 0208 DO j=1,4 0209 C e.g. lFld=33 => 1:1+2 9-2:9+2 17-2:17+2 25-2:25+2 33-2:33 0210 C e.g. lFld=32 => 1:1+2 8-2:9+2 16-2:17+2 24-2:25+2 32-2:32 0211 ic = (lFld-1)*(j-1)/4 0212 i1 = 1+ic-2 0213 i2 = 1+ic+2 0214 IF ( ic*4 .LT. (lFld-1)*(j-1) ) i2=i2+1 0215 i1 = MAX(i1,1) 0216 i2 = MIN(i2,lFld) 0217 CALL PRINT_LIST_RL( fld(i1), i1, i2, index_type, .TRUE., 0218 & .FALSE., standardMessageUnit ) 0219 WRITE(msgBuf,'(A)') ' . . .' 0220 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0221 & SQUEEZE_RIGHT , 1) 0222 ENDDO 0223 i1 = MAX(lFld-2,1) 0224 i2 = lFld 0225 CALL PRINT_LIST_RL( fld(i1), i1, i2, index_type, .FALSE., 0226 & .FALSE., standardMessageUnit ) 0227 ENDIF 0228 WRITE(msgBuf,'(A)') ' ; ' 0229 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0230 & SQUEEZE_RIGHT , 1) 0231 0232 RETURN 0233 END 0234 0235 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0236 0237 CBOP 0238 C !ROUTINE: WRITE_0D_I 0239 C !INTERFACE: 0240 SUBROUTINE WRITE_0D_I( fld, index_type, head, comment ) 0241 0242 C !DESCRIPTION: \bv 0243 C *==========================================================* 0244 C | o SUBROUTINE WRITE_0D_I 0245 C | Controls formatted, tabular I/O for an INTEGER variable. 0246 C *==========================================================* 0247 C | This routine produces a standard format for list 0248 C | one-dimensional INTEGER data in textual form. The format 0249 C | is designed to be readily parsed by a post-processing 0250 C | utility. 0251 C *==========================================================* 0252 C \ev 0253 0254 C !USES: 0255 IMPLICIT NONE 0256 C == Global data == 0257 #include "SIZE.h" 0258 #include "EEPARAMS.h" 0259 0260 C !INPUT/OUTPUT PARAMETERS: 0261 C == Routine arguments == 0262 C fld :: Field to be printed 0263 C index_type :: Type of index labelling (I=,J=,...) to use 0264 C head :: Statement start (e.g. phi = ) 0265 C comment :: Descriptive comment for field 0266 INTEGER fld 0267 INTEGER index_type 0268 CHARACTER*(*) head 0269 CHARACTER*(*) comment 0270 0271 C !LOCAL VARIABLES: 0272 C == Local variables == 0273 CHARACTER*(MAX_LEN_MBUF) msgBuf 0274 INTEGER idummy(1) 0275 CEOP 0276 0277 idummy(1) = fld 0278 0279 WRITE(msgBuf,'(A,A)') head, comment 0280 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0281 & SQUEEZE_RIGHT , 1) 0282 CALL PRINT_LIST_I( idummy, 1, 1, index_type, .FALSE., 0283 & .TRUE., standardMessageUnit ) 0284 WRITE(msgBuf,'(A)') ' ; ' 0285 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0286 & SQUEEZE_RIGHT , 1) 0287 0288 RETURN 0289 END 0290 0291 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0292 0293 CBOP 0294 C !ROUTINE: WRITE_0D_L 0295 C !INTERFACE: 0296 SUBROUTINE WRITE_0D_L( fld, index_type, head, comment ) 0297 0298 C !DESCRIPTION: \bv 0299 C *==========================================================* 0300 C | o SUBROUTINE WRITE_0D_L 0301 C | Controls formatted, tabular I/O for a LOGICAL variable. 0302 C *==========================================================* 0303 C | This routine produces a standard format for list 0304 C | one-dimensional LOGICAL data in textual form. The format 0305 C | is designed to be readily parsed by a post-processing 0306 C | utility. 0307 C *==========================================================* 0308 C \ev 0309 0310 C !USES: 0311 IMPLICIT NONE 0312 C == Global data == 0313 #include "SIZE.h" 0314 #include "EEPARAMS.h" 0315 0316 C !INPUT/OUTPUT PARAMETERS: 0317 C == Routine arguments == 0318 C fld :: Field to be printed 0319 C index_type :: Type of index labelling (I=,J=,...) to use 0320 C head :: Statement start (e.g. phi = ) 0321 C comment :: Descriptive comment for field 0322 LOGICAL fld 0323 INTEGER index_type 0324 CHARACTER*(*) head 0325 CHARACTER*(*) comment 0326 0327 C !LOCAL VARIABLES: 0328 C == Local variables == 0329 CHARACTER*(MAX_LEN_MBUF) msgBuf 0330 LOGICAL ldummy(1) 0331 CEOP 0332 0333 ldummy(1) = fld 0334 WRITE(msgBuf,'(A,A)') head, comment 0335 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0336 & SQUEEZE_RIGHT , 1) 0337 CALL PRINT_LIST_L( ldummy, 1, 1, index_type, .FALSE., 0338 & .TRUE., standardMessageUnit ) 0339 WRITE(msgBuf,'(A)') ' ; ' 0340 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0341 & SQUEEZE_RIGHT , 1) 0342 0343 RETURN 0344 END 0345 0346 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0347 0348 CBOP 0349 C !ROUTINE: WRITE_0D_R4 0350 C !INTERFACE: 0351 SUBROUTINE WRITE_0D_R4( fld, index_type, head, comment ) 0352 0353 C !DESCRIPTION: \bv 0354 C *==========================================================* 0355 C | o SUBROUTINE WRITE_0D_R4 0356 C | Controls formatted, tabular I/O for a real*4 variable. 0357 C *==========================================================* 0358 C | This routine produces a standard format for list 0359 C | one-dimensional real*4 data in textual form. The format 0360 C | is designed to be readily parsed by a post-processing 0361 C | utility. 0362 C *==========================================================* 0363 C \ev 0364 0365 C !USES: 0366 IMPLICIT NONE 0367 C == Global data == 0368 #include "SIZE.h" 0369 #include "EEPARAMS.h" 0370 0371 C !INPUT/OUTPUT PARAMETERS: 0372 C == Routine arguments == 0373 C fld :: Field to be printed 0374 C index_type :: Type of index labelling (I=,J=,...) to use 0375 C head :: Statement start (e.g. phi = ) 0376 C comment :: Descriptive comment for field 0377 Real*4 fld 0378 INTEGER index_type 0379 CHARACTER*(*) head 0380 CHARACTER*(*) comment 0381 0382 C !LOCAL VARIABLES: 0383 C == Local variables == 0384 CHARACTER*(MAX_LEN_MBUF) msgBuf 0385 _RL dummyRL(1) 0386 CEOP 0387 0388 C- convert to "RL" 0389 dummyRL(1) = fld 0390 0391 WRITE(msgBuf,'(A,A)') head, comment 0392 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0393 & SQUEEZE_RIGHT , 1) 0394 CALL PRINT_LIST_RL( dummyRL, 1, 1, index_type, .FALSE., 0395 & .TRUE., standardMessageUnit ) 0396 WRITE(msgBuf,'(A)') ' ; ' 0397 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0398 & SQUEEZE_RIGHT , 1) 0399 0400 RETURN 0401 END 0402 0403 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0404 0405 CBOP 0406 C !ROUTINE: WRITE_0D_R8 0407 C !INTERFACE: 0408 SUBROUTINE WRITE_0D_R8( fld, index_type, head, comment ) 0409 0410 C !DESCRIPTION: \bv 0411 C *==========================================================* 0412 C | o SUBROUTINE WRITE_0D_R8 0413 C | Controls formatted, tabular I/O for a real*8 variable. 0414 C *==========================================================* 0415 C | This routine produces a standard format for list 0416 C | one-dimensional real*8 data in textual form. The format 0417 C | is designed to be readily parsed by a post-processing 0418 C | utility. 0419 C *==========================================================* 0420 C \ev 0421 0422 C !USES: 0423 IMPLICIT NONE 0424 C == Global data == 0425 #include "SIZE.h" 0426 #include "EEPARAMS.h" 0427 0428 C !INPUT/OUTPUT PARAMETERS: 0429 C == Routine arguments == 0430 C fld :: Field to be printed 0431 C index_type :: Type of index labelling (I=,J=,...) to use 0432 C head :: Statement start (e.g. phi = ) 0433 C comment :: Descriptive comment for field 0434 Real*8 fld 0435 INTEGER index_type 0436 CHARACTER*(*) head 0437 CHARACTER*(*) comment 0438 0439 C !LOCAL VARIABLES: 0440 C == Local variables == 0441 CHARACTER*(MAX_LEN_MBUF) msgBuf 0442 _RL dummyRL(1) 0443 CEOP 0444 0445 C- convert to "RL" 0446 dummyRL(1) = fld 0447 0448 WRITE(msgBuf,'(A,A)') head, comment 0449 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0450 & SQUEEZE_RIGHT , 1) 0451 CALL PRINT_LIST_RL( dummyRL, 1, 1, index_type, .FALSE., 0452 & .TRUE., standardMessageUnit ) 0453 WRITE(msgBuf,'(A)') ' ; ' 0454 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0455 & SQUEEZE_RIGHT , 1) 0456 0457 RETURN 0458 END 0459 0460 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0461 0462 CBOP 0463 C !ROUTINE: WRITE_0D_RS 0464 C !INTERFACE: 0465 SUBROUTINE WRITE_0D_RS( fld, index_type, head, comment ) 0466 0467 C !DESCRIPTION: \bv 0468 C *==========================================================* 0469 C | o SUBROUTINE WRITE_0D_RS 0470 C | Controls formatted, tabular I/O for a real "RS" variable. 0471 C *==========================================================* 0472 C | This routine produces a standard format for list 0473 C | one-dimensional real data in textual form. The format 0474 C | is designed to be readily parsed by a post-processing 0475 C | utility. 0476 C *==========================================================* 0477 C \ev 0478 0479 C !USES: 0480 IMPLICIT NONE 0481 C == Global data == 0482 #include "SIZE.h" 0483 #include "EEPARAMS.h" 0484 0485 C !INPUT/OUTPUT PARAMETERS: 0486 C == Routine arguments == 0487 C fld :: Field to be printed 0488 C index_type :: Type of index labelling (I=,J=,...) to use 0489 C head :: Statement start (e.g. phi = ) 0490 C comment :: Descriptive comment for field 0491 _RS fld 0492 INTEGER index_type 0493 CHARACTER*(*) head 0494 CHARACTER*(*) comment 0495 0496 C !LOCAL VARIABLES: 0497 C == Local variables == 0498 CHARACTER*(MAX_LEN_MBUF) msgBuf 0499 _RL dummyRL(1) 0500 CEOP 0501 0502 C- convert to "RL" 0503 dummyRL(1) = fld 0504 0505 WRITE(msgBuf,'(A,A)') head, comment 0506 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0507 & SQUEEZE_RIGHT , 1) 0508 CALL PRINT_LIST_RL( dummyRL, 1, 1, index_type, .FALSE., 0509 & .TRUE., standardMessageUnit ) 0510 WRITE(msgBuf,'(A)') ' ; ' 0511 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0512 & SQUEEZE_RIGHT , 1) 0513 0514 RETURN 0515 END 0516 0517 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0518 0519 CBOP 0520 C !ROUTINE: WRITE_0D_RL 0521 C !INTERFACE: 0522 SUBROUTINE WRITE_0D_RL( fld, index_type, head, comment ) 0523 0524 C !DESCRIPTION: \bv 0525 C *==========================================================* 0526 C | o SUBROUTINE WRITE_0D_RL 0527 C | Controls formatted, tabular I/O for a real "RL" variable. 0528 C *==========================================================* 0529 C | This routine produces a standard format for list 0530 C | one-dimensional real data in textual form. The format 0531 C | is designed to be readily parsed by a post-processing 0532 C | utility. 0533 C *==========================================================* 0534 C \ev 0535 0536 C !USES: 0537 IMPLICIT NONE 0538 C == Global data == 0539 #include "SIZE.h" 0540 #include "EEPARAMS.h" 0541 0542 C !INPUT/OUTPUT PARAMETERS: 0543 C == Routine arguments == 0544 C fld :: Field to be printed 0545 C index_type :: Type of index labelling (I=,J=,...) to use 0546 C head :: Statement start (e.g. phi = ) 0547 C comment :: Descriptive comment for field 0548 _RL fld 0549 INTEGER index_type 0550 CHARACTER*(*) head 0551 CHARACTER*(*) comment 0552 0553 C !LOCAL VARIABLES: 0554 C == Local variables == 0555 CHARACTER*(MAX_LEN_MBUF) msgBuf 0556 _RL dummyRL(1) 0557 CEOP 0558 0559 C- copy to array "RL" 0560 dummyRL(1) = fld 0561 0562 WRITE(msgBuf,'(A,A)') head, comment 0563 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0564 & SQUEEZE_RIGHT , 1) 0565 CALL PRINT_LIST_RL( dummyRL, 1, 1, index_type, .FALSE., 0566 & .TRUE., standardMessageUnit ) 0567 WRITE(msgBuf,'(A)') ' ; ' 0568 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0569 & SQUEEZE_RIGHT , 1) 0570 0571 RETURN 0572 END 0573 0574 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0575 0576 CBOP 0577 C !ROUTINE: WRITE_0D_C 0578 C !INTERFACE: 0579 SUBROUTINE WRITE_0D_C( fld, lFld, index_type, head, comment ) 0580 0581 C !DESCRIPTION: \bv 0582 C *==========================================================* 0583 C | o SUBROUTINE WRITE_0D_C 0584 C | Controls formatted, tabular I/O for a character string 0585 C *==========================================================* 0586 C | This routine produces a standard format for list 0587 C | a character string data in textual form. The format 0588 C | is designed to be readily parsed by a post-processing 0589 C | utility. 0590 C *==========================================================* 0591 C \ev 0592 0593 C !USES: 0594 IMPLICIT NONE 0595 C == Global data == 0596 #include "SIZE.h" 0597 #include "EEPARAMS.h" 0598 0599 C !INPUT/OUTPUT PARAMETERS: 0600 C == Routine arguments == 0601 C fld :: Field to be printed 0602 C lFld :: Number of character (in field "fld") to print 0603 C 0 = all ; -1 & -2 = until the last non-blank 0604 C -2 = starting at the first non-blank 0605 C index_type :: Type of index labelling (I=,J=,...) to use 0606 C head :: Statement start (e.g. phi = ) 0607 C comment :: Descriptive comment for field 0608 CHARACTER*(*) fld 0609 INTEGER lFld 0610 INTEGER index_type 0611 CHARACTER*(*) head 0612 CHARACTER*(*) comment 0613 0614 C !FUNCTIONS: 0615 INTEGER IFNBLNK 0616 INTEGER ILNBLNK 0617 EXTERNAL IFNBLNK 0618 EXTERNAL ILNBLNK 0619 0620 C !LOCAL VARIABLES: 0621 C == Local variables == 0622 CHARACTER*(MAX_LEN_MBUF) msgBuf 0623 INTEGER iS,iL 0624 CEOP 0625 0626 iS = 1 0627 iL = LEN(fld) 0628 IF ( lFld .GT. 0 ) THEN 0629 iL = MIN( lFld, iL ) 0630 ELSEIF ( lFld .LT. 0 ) THEN 0631 iL = ILNBLNK(fld) 0632 ENDIF 0633 IF ( lFld .EQ. -2 ) iS = IFNBLNK(fld) 0634 iS = MAX(1,iS) 0635 0636 WRITE(msgBuf,'(A,A)') head, comment 0637 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0638 & SQUEEZE_RIGHT, 1 ) 0639 IF ( iL.GE.iS ) THEN 0640 iL = MIN( MAX_LEN_MBUF + iS - 17, iL ) 0641 WRITE(msgBuf,'(14X,3A)') "'", fld(iS:iL), "'" 0642 ELSE 0643 WRITE(msgBuf,'(14X,3A)') "'","'" 0644 ENDIF 0645 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0646 & SQUEEZE_RIGHT, 1 ) 0647 WRITE(msgBuf,'(A)') ' ;' 0648 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 0649 & SQUEEZE_RIGHT, 1 ) 0650 0651 RETURN 0652 END 0653 0654 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0655 0656 CBOP 0657 C !ROUTINE: WRITE_COPY1D_R4 0658 C !INTERFACE: 0659 SUBROUTINE WRITE_COPY1D_R4( 0660 O tmpBufRL, 0661 I fld, lFld, index_type, head, comment ) 0662 0663 C !DESCRIPTION: \bv 0664 C *==========================================================* 0665 C | o SUBROUTINE WRITE_COPY1D_R4 0666 C | Write as formatted I/O to STDOUT a copy (in "RL" buffer) 0667 C | of a one-dimensional real*4 field. 0668 C *==========================================================* 0669 C | Copy the 1.D array (fld) to "RL" type buffer (tmpBufRL) 0670 C | and then call WRITE_1D_RL; 0671 C | Length of buffer array must be equal or larger than 0672 C | input 1.D field (fld) to write. 0673 C *==========================================================* 0674 C \ev 0675 0676 C !USES: 0677 IMPLICIT NONE 0678 C == Global data == 0679 #include "SIZE.h" 0680 #include "EEPARAMS.h" 0681 0682 C !INPUT/OUTPUT PARAMETERS: 0683 C == Routine arguments == 0684 C tmpBufRL :: buffer ("RL" type) passed to WRITE_1D_RL 0685 C fld :: Field to be printed 0686 C lFld :: Number of elements (in field "fld") to print 0687 C index_type :: Type of index labelling (I=,J=,...) to use 0688 C head :: Statement start (e.g. phi = ) 0689 C comment :: Descriptive comment for field 0690 INTEGER lFld 0691 _RL tmpBufRL(lFld) 0692 Real*4 fld(lFld) 0693 INTEGER index_type 0694 CHARACTER*(*) head 0695 CHARACTER*(*) comment 0696 0697 C !LOCAL VARIABLES: 0698 C == Local variables == 0699 INTEGER i 0700 CEOP 0701 0702 DO i=1,lFld 0703 tmpBufRL(i) = fld(i) 0704 ENDDO 0705 CALL WRITE_1D_RL( tmpBufRL, lFld, index_type, head, comment ) 0706 0707 RETURN 0708 END 0709 0710 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0711 0712 CBOP 0713 C !ROUTINE: WRITE_COPY1D_R8 0714 C !INTERFACE: 0715 SUBROUTINE WRITE_COPY1D_R8( 0716 O tmpBufRL, 0717 I fld, lFld, index_type, head, comment ) 0718 0719 C !DESCRIPTION: \bv 0720 C *==========================================================* 0721 C | o SUBROUTINE WRITE_COPY1D_R8 0722 C | Write as formatted I/O to STDOUT a copy (in "RL" buffer) 0723 C | of a one-dimensional real*8 field. 0724 C *==========================================================* 0725 C | Copy the 1.D array (fld) to "RL" type buffer (tmpBufRL) 0726 C | and then call WRITE_1D_RL; 0727 C | Length of buffer array must be equal or larger than 0728 C | input 1.D field (fld) to write. 0729 C *==========================================================* 0730 C \ev 0731 0732 C !USES: 0733 IMPLICIT NONE 0734 C == Global data == 0735 #include "SIZE.h" 0736 #include "EEPARAMS.h" 0737 0738 C !INPUT/OUTPUT PARAMETERS: 0739 C == Routine arguments == 0740 C tmpBufRL :: buffer ("RL" type) passed to WRITE_1D_RL 0741 C fld :: Field to be printed 0742 C lFld :: Number of elements (in field "fld") to print 0743 C index_type :: Type of index labelling (I=,J=,...) to use 0744 C head :: Statement start (e.g. phi = ) 0745 C comment :: Descriptive comment for field 0746 INTEGER lFld 0747 _RL tmpBufRL(lFld) 0748 Real*8 fld(lFld) 0749 INTEGER index_type 0750 CHARACTER*(*) head 0751 CHARACTER*(*) comment 0752 0753 C !LOCAL VARIABLES: 0754 C == Local variables == 0755 INTEGER i 0756 CEOP 0757 0758 DO i=1,lFld 0759 tmpBufRL(i) = fld(i) 0760 ENDDO 0761 CALL WRITE_1D_RL( tmpBufRL, lFld, index_type, head, comment ) 0762 0763 RETURN 0764 END 0765 0766 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0767 0768 CBOP 0769 C !ROUTINE: WRITE_COPY1D_RS 0770 C !INTERFACE: 0771 SUBROUTINE WRITE_COPY1D_RS( 0772 O tmpBufRL, 0773 I fld, lFld, index_type, head, comment ) 0774 0775 C !DESCRIPTION: \bv 0776 C *==========================================================* 0777 C | o SUBROUTINE WRITE_COPY1D_RS 0778 C | Write as formatted I/O to STDOUT a copy (in "RL" buffer) 0779 C | of a one-dimensional RS field. 0780 C *==========================================================* 0781 C | Copy the 1.D array (fld) to "RL" type buffer (tmpBufRL) 0782 C | and then call WRITE_1D_RL; 0783 C | Length of buffer array must be equal or larger than 0784 C | input 1.D field (fld) to write. 0785 C *==========================================================* 0786 C \ev 0787 0788 C !USES: 0789 IMPLICIT NONE 0790 C == Global data == 0791 #include "SIZE.h" 0792 #include "EEPARAMS.h" 0793 0794 C !INPUT/OUTPUT PARAMETERS: 0795 C == Routine arguments == 0796 C tmpBufRL :: buffer ("RL" type) passed to WRITE_1D_RL 0797 C fld :: Field to be printed 0798 C lFld :: Number of elements (in field "fld") to print 0799 C index_type :: Type of index labelling (I=,J=,...) to use 0800 C head :: Statement start (e.g. phi = ) 0801 C comment :: Descriptive comment for field 0802 INTEGER lFld 0803 _RL tmpBufRL(lFld) 0804 _RS fld(lFld) 0805 INTEGER index_type 0806 CHARACTER*(*) head 0807 CHARACTER*(*) comment 0808 0809 C !LOCAL VARIABLES: 0810 C == Local variables == 0811 INTEGER i 0812 CEOP 0813 0814 DO i=1,lFld 0815 tmpBufRL(i) = fld(i) 0816 ENDDO 0817 CALL WRITE_1D_RL( tmpBufRL, lFld, index_type, head, comment ) 0818 0819 RETURN 0820 END 0821 0822 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0823 0824 CBOP 0825 C !ROUTINE: WRITE_XY_XLINE_RS 0826 C !INTERFACE: 0827 SUBROUTINE WRITE_XY_XLINE_RS( 0828 I fld, sCoord, tCoord, 0829 I head, comment ) 0830 0831 C !DESCRIPTION: \bv 0832 C *==========================================================* 0833 C | o SUBROUTINE WRITE_XY_XLINE_RS 0834 C | Prints out X row of an XY RS field e.g. phi(:,n,:,m) 0835 C *==========================================================* 0836 C | This routine produces a standard format for list 0837 C | one-dimensional RS data in textual form. The format 0838 C | is designed to be readily parsed by a post-processing 0839 C | utility. 0840 C *==========================================================* 0841 C \ev 0842 0843 C !USES: 0844 IMPLICIT NONE 0845 C == Global data == 0846 #include "SIZE.h" 0847 #include "EEPARAMS.h" 0848 0849 C !INPUT/OUTPUT PARAMETERS: 0850 C == Routine arguments == 0851 C fld :: Field to be printed along X.direction 0852 C sCoord :: subgrid coordinate 0853 C tCoord :: tile coordinate 0854 C head :: Statement start (e.g. phi = ) 0855 C comment :: Descriptive comment for field 0856 _RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) 0857 INTEGER sCoord 0858 INTEGER tCoord 0859 CHARACTER*(*) head 0860 CHARACTER*(*) comment 0861 0862 C !FUNCTIONS: 0863 EXTERNAL IFNBLNK 0864 INTEGER IFNBLNK 0865 EXTERNAL ILNBLNK 0866 INTEGER ILNBLNK 0867 0868 C !LOCAL VARIABLES: 0869 C == Local variables == 0870 CHARACTER*(MAX_LEN_MBUF) msgBuf1 0871 CHARACTER*(MAX_LEN_MBUF) msgBuf2 0872 CHARACTER*10 num1, num2 0873 _RL xcoord(sNx*nSx) 0874 INTEGER bi, bj, i, j 0875 INTEGER IFN1, ILN1, IFN2, ILN2 0876 CEOP 0877 0878 WRITE(msgBuf1,'(A,A)') head,' = ' 0879 bj = tCoord 0880 J = sCoord 0881 WRITE(num1,'(I10)') J 0882 WRITE(num2,'(I10)') bj 0883 IFN1 = IFNBLNK(num1) 0884 ILN1 = ILNBLNK(num1) 0885 IFN2 = IFNBLNK(num2) 0886 ILN2 = ILNBLNK(num2) 0887 C fld(:,J,:,bj) 0888 WRITE(msgBuf2,'(A,A,A,A,A,A,A,A,A)') 0889 & ' /* ', head,'(:,', 0890 & num1(IFN1:ILN1),',:,', 0891 & num2(IFN2:ILN2),') ', 0892 & comment,' */' 0893 DO bi=1,nSx 0894 DO I=1,sNx 0895 xcoord(sNx*(bi-1)+I)=fld(I,J,bi,bj) 0896 ENDDO 0897 ENDDO 0898 CALL WRITE_1D_RL( xcoord, sNx*nSx, INDEX_I,msgBuf1,msgBuf2) 0899 0900 RETURN 0901 END 0902 0903 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0904 0905 CBOP 0906 C !ROUTINE: WRITE_XY_YLINE_RS 0907 C !INTERFACE: 0908 SUBROUTINE WRITE_XY_YLINE_RS( 0909 I fld, sCoord, tCoord, 0910 I head, comment ) 0911 0912 C !DESCRIPTION: \bv 0913 C *==========================================================* 0914 C | o SUBROUTINE WRITE_XY_YLINE_RS 0915 C | Prints out Y row of an XY RS field e.g. phi(n,:,m,:) 0916 C *==========================================================* 0917 C | This routine produces a standard format for list 0918 C | one-dimensional RS data in textual form. The format 0919 C | is designed to be readily parsed by a post-processing 0920 C | utility. 0921 C *==========================================================* 0922 C \ev 0923 0924 C !USES: 0925 IMPLICIT NONE 0926 C == Global data == 0927 #include "SIZE.h" 0928 #include "EEPARAMS.h" 0929 0930 C !INPUT/OUTPUT PARAMETERS: 0931 C == Routine arguments == 0932 C fld :: Field to be printed along Y.direction 0933 C sCoord :: subgrid coordinate 0934 C tCoord :: tile coordinate 0935 C head :: Statement start (e.g. phi = ) 0936 C comment :: Descriptive comment for field 0937 _RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) 0938 INTEGER sCoord 0939 INTEGER tCoord 0940 CHARACTER*(*) head 0941 CHARACTER*(*) comment 0942 0943 C !FUNCTIONS: 0944 EXTERNAL IFNBLNK 0945 INTEGER IFNBLNK 0946 EXTERNAL ILNBLNK 0947 INTEGER ILNBLNK 0948 0949 C !LOCAL VARIABLES: 0950 C == Local variables == 0951 CHARACTER*(MAX_LEN_MBUF) msgBuf1 0952 CHARACTER*(MAX_LEN_MBUF) msgBuf2 0953 _RL ycoord(sNy*nSy) 0954 INTEGER bi, bj, i, j 0955 CHARACTER*10 num1, num2 0956 INTEGER IFN1, ILN1, IFN2, ILN2 0957 CEOP 0958 0959 WRITE(msgBuf1,'(A,A)') head,' = ' 0960 bi = tCoord 0961 I = sCoord 0962 WRITE(num1,'(I10)') I 0963 WRITE(num2,'(I10)') bi 0964 IFN1 = IFNBLNK(num1) 0965 ILN1 = ILNBLNK(num1) 0966 IFN2 = IFNBLNK(num2) 0967 ILN2 = ILNBLNK(num2) 0968 C fld(I,:,bi,:) 0969 WRITE(msgBuf2,'(A,A,A,A,A,A,A,A,A)') 0970 & ' /* ',head,'(', 0971 & num1(IFN1:ILN1),',:,', 0972 & num2(IFN2:ILN2),',:) ', 0973 & comment,' */' 0974 DO bj=1,nSy 0975 DO J=1,sNy 0976 ycoord(sNy*(bj-1)+J)=fld(I,J,bi,bj) 0977 ENDDO 0978 ENDDO 0979 CALL WRITE_1D_RL( ycoord, sNy*nSy, INDEX_J,msgBuf1,msgBuf2) 0980 0981 RETURN 0982 END
| [ Source navigation ] | [ Diff markup ] | [ Identifier search ] | [ general search ] |
|
This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine. The LXR team |
|