*** COPIED FROM 'A0568.NEW.FORT(GOUT)' ON 1989.10.1 SUBROUTINE GOUT 1(GDATA,IDATA,IMAX,JMAX,IS,JS,IE,JE,II,JI,BASE,FACT,ITTL,LEV) C C DIMENSION GDATA(IMAX,JMAX,lEV) DIMENSION IDATA(IMAX,JMAX) DIMENSION JJ(JMAX) CHARACTER*4 ITTL C C KMAX=LEV C DO 1000 K=1,KMAX C DO 1000 K=1,LEV GMAX=GDATA(1,1,K) GMIN=GDATA(1,1,K) DO 100 I=1,IMAX DO 100 J=1,JMAX GMAX=MAX(GMAX,GDATA(I,J,K)) GMIN=MIN(GMIN,GDATA(I,J,K)) 100 CONTINUE C FACT1=FACT 2000 CONTINUE GABS =FACT1*MAX(ABS(GMAX-BASE),ABS(GMIN-BASE)) IF(GABS.GT.999.0) THEN FACT1=0.1*FACT1 GO TO 2000 END IF C DO 200 J=1,JMAX DO 200 I=1,IMAX IDATA(IMAX+1-I,J)=INT(FACT1*(GDATA(I,J,K)-BASE)) 200 CONTINUE C 999 FORMAT(1H ,//,' TITLE=',A4,' LEVEL=',I2,' START=(',I2, 1',',I2,') END=(',I3,',',I3,') INTVL=(',I1,',',I1,')',/) 888 FORMAT(1H ,2X,' MAX=',E12.5,' MIN=',E12.5) 777 FORMAT(1H ,2X,'BASE=',E12.5,' FACT=',E12.5,' G(3,3)=',E12.5,//) 666 FORMAT(1H ,I3,1X,32I4) 555 FORMAT(1H ,//,' CONSTANT FIELD ',//) 444 FORMAT(1H , 4X,32I4) C IF(GMAX.EQ.GMIN) THEN WRITE(96,999) ITTL,K,IS,JS,IE,JE,II,JI WRITE(96,888) GMAX,GMIN WRITE(96,777) BASE,FACT1,GDATA(3,3,K) WRITE(96,555) ELSE JC=0 DO 500 J=JS,JE,JI JC=JC+1 JJ(J)=J 500 CONTINUE JITR=JC/32 JRMN=JC-JITR*32 JEX=JS-JI C IF(JITR.NE.0) THEN DO 600 ITR=1,JITR WRITE(96,999) ITTL,K,IS,JS,IE,JE,II,JI WRITE(96,888) GMAX,GMIN WRITE(96,777) BASE,FACT1,GDATA(3,3,K) JSX=JEX+ JI JEX=JSX+31*JI WRITE(96,444) (JJ (J),J=JSX,JEX,JI) DO 600 I=IS,IE,II WRITE(96,666) IMAX+1-I,(IDATA(I,J),J=JSX,JEX,JI) 600 CONTINUE END IF IF(JRMN.GE.1) THEN JSX=JEX+JI JEX=JE WRITE(96,999) ITTL,K,IS,JS,IE,JE,II,JI WRITE(96,888) GMAX,GMIN WRITE(96,777) BASE,FACT1,GDATA(3,3,K) WRITE(96,444) (JJ (J),J=JSX,JEX,JI) DO 700 I=IS,IE,II WRITE(96,666) IMAX+1-I,(IDATA(I,J),J=JSX,JEX,JI) 700 CONTINUE CLSW Crizvi DO 800 J=JSX,JEX Crizvi WRITE(99,FMT='(10F12.5,1x)') (GDATA(I,J,K),I=IS,IE) Crizvi 800 CONTINUE CLSW END IF END IF 1000 CONTINUE C RETURN END SUBROUTINE GOUT