1 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC 2 ! C 3 ! Module name: WRITE_TABLE (LEGEND, ARRAY, DIST_MIN, LSTART, LEND) C 4 ! Purpose: To write a table of DX, DY, DZ, and cell wall locations C 5 ! C 6 ! Author: M. Syamlal Date: 09-JAN-92 C 7 ! Reviewer: S. Venkatesan Date: 11-DEC-92 C 8 ! C 9 ! Revision Number: C 10 ! Purpose: C 11 ! Author: Date: dd-mmm-yy C 12 ! Reviewer: Date: dd-mmm-yy C 13 ! C 14 ! Literature/Document References: C 15 ! C 16 ! Variables referenced: None C 17 ! Variables modified: None C 18 ! C 19 ! Local variables: NROW, L, L1, L2, L3, DIST, ARRAY1, ARRAY3 C 20 ! C 21 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C 22 ! 23 SUBROUTINE WRITE_TABLE(LEGEND, ARRAY, DIST_MIN, LSTART, LEND) 24 !...Translated by Pacific-Sierra Research VAST-90 2.06G5 12:17:31 12/09/98 25 !...Switches: -xf 26 ! 27 !----------------------------------------------- 28 ! M o d u l e s 29 !----------------------------------------------- 30 USE param 31 USE param1 32 USE funits 33 IMPLICIT NONE 34 !----------------------------------------------- 35 ! D u m m y A r g u m e n t s 36 !----------------------------------------------- 37 ! 38 ! Legend 39 CHARACTER(LEN=*) LEGEND(3) 40 ! 41 ! DX, DY, or DZ Array to be written 42 43 44 ! Starting array index 45 INTEGER LSTART 46 ! 47 ! Ending array index 48 INTEGER LEND 49 !//EFD Nov/11, avoid use of (*) 50 !// DOUBLE PRECISION ARRAY(*) 51 DOUBLE PRECISION ARRAY((LSTART-1):(LEND+1)) 52 ! 53 ! Starting value of distance 54 DOUBLE PRECISION DIST_MIN 55 ! 56 !----------------------------------------------- 57 ! L o c a l P a r a m e t e r s 58 !----------------------------------------------- 59 ! 60 ! Number of columns in the table. When this is changed 61 ! remember to change the FORMAT statement also. 62 INTEGER, PARAMETER :: NCOL = 5 63 ! 64 ! Some dimension large enough for I, J, and K. 65 INTEGER, PARAMETER :: DIMENSION_1 = MAX(DIM_I, DIM_J, DIM_K) 66 67 !----------------------------------------------- 68 ! L o c a l V a r i a b l e s 69 !----------------------------------------------- 70 ! 71 ! Indices 72 INTEGER ARRAY1(DIMENSION_1) 73 ! 74 ! Array3 to be written 75 DOUBLE PRECISION ARRAY3(DIMENSION_1) 76 ! 77 ! Number of rows 78 INTEGER NROW 79 ! 80 ! Temporary storage for distance calculation 81 DOUBLE PRECISION DIST 82 ! 83 ! Local array indices 84 INTEGER L, L1, L2, L3 85 !----------------------------------------------- 86 ! 87 ! 88 ! Fill arrays 1 and 3 89 ! 90 DIST = DIST_MIN 91 DO L = LSTART, LEND 92 ARRAY1(L) = L 93 ARRAY3(L) = DIST 94 IF (L < LEND) DIST = DIST + ARRAY(L+1) 95 END DO 96 NROW = (LEND - LSTART + 1)/NCOL 97 ! 98 L2 = LSTART - 1 99 DO L = 1, NROW 100 L1 = L2 + 1 101 L2 = L1 + NCOL - 1 102 WRITE (UNIT_OUT, 1010) LEGEND(1), (ARRAY1(L3),L3=L1,L2) 103 WRITE (UNIT_OUT, 1020) LEGEND(2), (ARRAY(L3),L3=L1,L2) 104 WRITE (UNIT_OUT, 1030) LEGEND(3), (ARRAY3(L3),L3=L1,L2) 105 END DO 106 IF (NROW*NCOL < LEND - LSTART + 1) THEN 107 L1 = L2 + 1 108 L2 = LEND 109 WRITE (UNIT_OUT, 1010) LEGEND(1), (ARRAY1(L3),L3=L1,L2) 110 WRITE (UNIT_OUT, 1020) LEGEND(2), (ARRAY(L3),L3=L1,L2) 111 WRITE (UNIT_OUT, 1030) LEGEND(3), (ARRAY3(L3),L3=L1,L2) 112 ENDIF 113 RETURN 114 ! 115 1010 FORMAT(7X,A3,2X,5(4X,I3,5X,1X)) 116 1020 FORMAT(7X,A3,2X,5(G12.5,1X)) 117 1030 FORMAT(7X,A3,2X,5(G12.5,1X),/) 118 END SUBROUTINE WRITE_TABLE 119