GOUT.inc

1 *** COPIED FROM 'A0568.NEW.FORT(GOUT)' ON 1989.10.1
2       SUBROUTINE GOUT
3      1(GDATA,IDATA,IMAX,JMAX,IS,JS,IE,JE,II,JI,BASE,FACT,ITTL,LEV)
4 C
5 C
6       DIMENSION GDATA(IMAX,JMAX,lEV)
7       DIMENSION IDATA(IMAX,JMAX)
8       DIMENSION JJ(JMAX)
9       CHARACTER*4 ITTL
10 C
11 C     KMAX=LEV
12 C     DO 1000 K=1,KMAX
13 C
14       DO 1000 K=1,LEV
15       GMAX=GDATA(1,1,K)
16       GMIN=GDATA(1,1,K)
17 
18       DO 100 I=1,IMAX
19       DO 100 J=1,JMAX
20       GMAX=MAX(GMAX,GDATA(I,J,K))
21       GMIN=MIN(GMIN,GDATA(I,J,K))
22   100 CONTINUE
23 C
24       FACT1=FACT
25  2000 CONTINUE
26       GABS =FACT1*MAX(ABS(GMAX-BASE),ABS(GMIN-BASE))
27       IF(GABS.GT.999.0) THEN
28       FACT1=0.1*FACT1
29       GO TO 2000
30       END IF
31 C
32       DO 200 J=1,JMAX
33       DO 200 I=1,IMAX
34       IDATA(IMAX+1-I,J)=INT(FACT1*(GDATA(I,J,K)-BASE))
35   200 CONTINUE
36 C
37   999 FORMAT(1H ,//,'  TITLE=',A4,'  LEVEL=',I2,'   START=(',I2,
38      1',',I2,')   END=(',I3,',',I3,')   INTVL=(',I1,',',I1,')',/)
39   888 FORMAT(1H ,2X,' MAX=',E12.5,'   MIN=',E12.5)
40   777 FORMAT(1H ,2X,'BASE=',E12.5,'  FACT=',E12.5,'  G(3,3)=',E12.5,//)
41   666 FORMAT(1H ,I3,1X,32I4)
42   555 FORMAT(1H ,//,'   CONSTANT FIELD   ',//)
43   444 FORMAT(1H ,   4X,32I4)
44 C
45       IF(GMAX.EQ.GMIN) THEN
46         WRITE(96,999) ITTL,K,IS,JS,IE,JE,II,JI
47         WRITE(96,888) GMAX,GMIN
48         WRITE(96,777) BASE,FACT1,GDATA(3,3,K)
49         WRITE(96,555)
50       ELSE
51         JC=0
52         DO 500 J=JS,JE,JI
53         JC=JC+1
54         JJ(J)=J
55   500   CONTINUE
56         JITR=JC/32
57         JRMN=JC-JITR*32
58         JEX=JS-JI
59 C
60         IF(JITR.NE.0) THEN
61           DO 600 ITR=1,JITR
62           WRITE(96,999) ITTL,K,IS,JS,IE,JE,II,JI
63           WRITE(96,888) GMAX,GMIN
64           WRITE(96,777) BASE,FACT1,GDATA(3,3,K)
65           JSX=JEX+   JI
66           JEX=JSX+31*JI
67           WRITE(96,444)   (JJ     (J),J=JSX,JEX,JI)
68           DO 600 I=IS,IE,II
69           WRITE(96,666) IMAX+1-I,(IDATA(I,J),J=JSX,JEX,JI)
70   600     CONTINUE
71         END IF
72         IF(JRMN.GE.1) THEN
73           JSX=JEX+JI
74           JEX=JE
75           WRITE(96,999) ITTL,K,IS,JS,IE,JE,II,JI
76           WRITE(96,888) GMAX,GMIN
77           WRITE(96,777) BASE,FACT1,GDATA(3,3,K)
78           WRITE(96,444)   (JJ     (J),J=JSX,JEX,JI)
79           DO 700 I=IS,IE,II
80           WRITE(96,666) IMAX+1-I,(IDATA(I,J),J=JSX,JEX,JI)
81   700     CONTINUE
82 CLSW
83 Crizvi          DO 800 J=JSX,JEX
84 Crizvi          WRITE(99,FMT='(10F12.5,1x)') (GDATA(I,J,K),I=IS,IE)
85 Crizvi  800     CONTINUE
86 CLSW
87         END IF
88       END IF
89 
90  1000  CONTINUE
91 C
92       RETURN
93       END SUBROUTINE GOUT
94