C file-name GXRESULT.FOR 140323
C-----------------------------------------------------------------------
SUBROUTINE GXRESULT
C... Subroutine to create condensed result file and display in default browser
INCLUDE 'farray'
INCLUDE 'satgrd'
INCLUDE 'satear'
INCLUDE 'grdear'
INCLUDE 'lbnamer'
INCLUDE 'd_earth/cmnmbf'
COMMON /CGLDIM/NX0,NY0,NZ0
COMMON/LPAREA/MIMD
LOGICAL MIMD
COMMON/PRINFO/NPROC,MYID,NNN1
COMMON /INDAUX/L0ISL,L0IST,L0SL,L0ST,NSTO,NSOL,L0SLRS,L0TTRS,
1 L0TTFL,L0TTLS,L0MAXC,L0MAXV,L0MINV,L0RATE,L0MAXI,L0NETT,
1 L0TTFLM,L0TTFLX,L0TTFLY,L0TTFLZ
COMMON/IHILO/IXHI3D,IYHI3D,IZHI3D,IXLO3D,IYLO3D,IZLO3D,IMAXC(150)
COMMON /UVWGBF/ IUC1GCV,IVC1GCV,IWC1GCV,IFILGCV(9)
COMMON/GENI/NXNY,NXM1NY,NXNYST,NDIR,KDUMM,NXST,NYST,NXNYFM,
1IZ,NFM,NWHOLE,IGSH,MVAR,KTRAN,NJ,NM,NXNYNZ,NXM1,IPAT1,NYM1,
1NYP1,NZM1,J0FRST,IZFSTP,IPAT2,ITHY,ITER,IXPRL0,IYPRL0,NWHF,
1NDVDP,IPRL,IBTAU,ILTLS,ISKIN,ISTAN,IYPLS,ISTRS,NFMAK1,NFMAK2,
1IREWR,NPHI2,NFTOT,MINF,M0FRST,LOOPZ,NPHI3,KXY0,NPHI4,ITEM1,
1ITEM2,ISPH1,ISPH2,IPOT,ICON2,IPRPS,IRADX,IRADY,IRADZ,IVFOL
COMMON/GXMON2/PLTCLSX; LOGICAL PLTCLSX
DIMENSION IMONTH(12),LDAY(7),LMONTH(12),ITIME(20)
CHARACTER LINE*80,OUTPUT*80,CH2*2,CH4*4,TEMLIN*80
CHARACTER*80 OUT0,UNIT1,UNIT2
CHARACTER*32 PCX_BACK
CHARACTER DAY(7)*9,MONTH(12)*9
CHARACTER*256 FILNAM,BUF1,CHGR_GEN*13,BUFF(5)*80,CURRENT_DIR,WPNAM
LOGICAL NOSOR,SOLVE,LVAL
INTEGER M4*4
EXTERNAL MCLOCK
DATA IMONTH /31,28,31,30,31,30,31,31,30,31,30,31/
DATA LDAY /6,8,6,6,7,9,8 /
DATA LMONTH /7,8,5,5,3,4,4,6,9,7,8,8/
DATA DAY/'Friday ','Saturday ','Sunday ','Monday ',
1 'Tuesday ','Wednesday','Thursday '/
DATA MONTH/'January ','February ','March ','April ',
1 'May ','June ','July ','August ',
1 'September','October ','November ','December '/
C----------------------------------------------------------------------
FILNAM='minires.htm'
LU=231
110 CONTINUE
OPEN(LU,FILE=FILNAM,STATUS='UNKNOWN',IOSTAT=IERR)
CLOSE(LU,STATUS='DELETE',IOSTAT=IERR)
IF(IERR/=0) THEN
BUFF(1)='Error opening file '//FILNAM(:LENGZZ(FILNAM))
BUFF(3)='Is it already opened in another program?'
BUFF(4)=
1 'If so, close the other program and click OK to try again,'
BUFF(5)='or Cancel to abort saving mini result'
CALL IOEMZZ(IERR,BUFF(2)) ! get system error message
IACT=1; CALL ERRMSG(BUFF,5,222,IACT) ! display error dialog
IF(IACT.EQ.0 )THEN
CLOSE(LU,IOSTAT=IOS); GO TO 110 ! go to top and try again
ELSE
RETURN ! exit
ENDIF
ENDIF
OPEN(LU,FILE=FILNAM,STATUS='NEW',IOSTAT=IERR)
IF(IERR/=0) GO TO 110
WRITE(LU,'('''')')
WRITE(LU,'('''')')
WRITE(LU,'(''''
1 )')
WRITE(LU,'(''Convergence Report'')')
WRITE(LU,'('''')')
WRITE(LU,'('''')')
!DEC$ IF .NOT.DEFINED(_RHINO_)
WRITE(LU,'('''')')
!DEC$ ELSE
WRITE(LU,
1'('''',
1 '''')')
!DEC$ ENDIF
C
ITIME(1)=-999
CALL MCLOCK(ITIME)
IY=ITIME(1); IM=ITIME(2); ID=ITIME(3); IH=ITIME(4); IMIN=ITIME(5)
IS=ITIME(6); LC=1; LINE=' '
ICPU=NINT(FLOAT((ITIME(19)+ITIME(20)))/1000.)
c
IF(IY==(-999)) THEN
OUTPUT=LINE
ELSE
c assemble time information
CALL NUM2(IH,CH2)
LINE(LC:LC+1)=CH2; LC=LC+2
LINE(LC:LC)=':'; LC=LC+1
CALL NUM2(IMIN,CH2)
LINE(LC:LC+1)=CH2; LC=LC+2
LINE(LC:LC)=':'; LC=LC+1
CALL NUM2(IS,CH2)
LINE(LC:LC+1)=CH2; LC=LC+2
LINE(LC:LC+3)=' on '; LC=LC+3
c calculate the day of the week
IF(MOD(IY,4)==0) IMONTH(2)=29
IREF=0
DO I=1983,IY
IREF=IREF+1
IF(MOD(I-1,4)==0) IREF=IREF+1
ENDDO
ISUM=0; I1=IM-1
DO I=1,I1
ISUM=ISUM+IMONTH(I)
ENDDO
ISUM=ISUM+ID+IREF
ISUM=MOD(ISUM,7)
IF(ISUM==0) ISUM=7
c glue together output buffer
LDAYT=LDAY(ISUM); LMONT=LMONTH(IM)
CALL NUM4(IY,CH4); CALL NUM2(ID,CH2)
OUTPUT=' '
OUTPUT(1:LC)=LINE(1:LC)
TEMLIN(1:9)=DAY(ISUM)
OUTPUT(LC+1:LDAYT+LC)=TEMLIN(1:LDAYT); LC=LC+LDAYT+1
OUTPUT(LC:LC+1)=', '; LC=LC+2
OUTPUT(LC:LC+1)=CH2; LC=LC+2
OUTPUT(LC:LC)=' '; LC=LC+1
TEMLIN(1:9)=MONTH(IM)
OUTPUT(LC:LC+LMONT-1)=TEMLIN(1:LMONT); LC=LC+LMONT
OUTPUT(LC:LC)=' ' ; LC=LC+1
OUTPUT(LC:LC+3)=CH4
ENDIF
BUF1=OUTPUT
IF(BUF1/=' ') THEN
WRITE(LU,'(''
Convergence information for '',
1 ''run completed at '',A,''
'')') BUF1(1:LENGZZ(BUF1))
ELSE
WRITE(LU,'(''
Convergence information for '',
1 ''run completed
'')')
ENDIF
IF(STEADY) THEN
WRITE(LU,'(''
on sweep '',I6,''
'')')
1 ISWEEP
ELSE
WRITE(LU,'(''
on time step'',I6,'' elapsed '',
1 ''time '',A,''s
'')') ISTEP, CHGR_GEN(TIM)
ENDIF
IF(MESS(1:40)/=' ') THEN
LL=LENGZZ(MESS)
WRITE(LU,'(''
'')') ! No nett source for velocity, KE or EP
ENDIF
TOTR= UGETMON(M4,2) ! total residual
IF(SELREF) THEN
RESID=100.*TOTR
IF(RESID<=TOL3) THEN
BUF1='(''
An explanation of the above''
1,'' table is given here.
'')')
WRITE(LU,'(''
To see the full source and '',
1''residual printout, click here then search for
1"Sources and sinks".
'')')
IF(NRED>0) THEN
WRITE(LU,'(''
High residual errors have ''
1 ''been detected in this run. Please review the results ''
1 ''carefully before proceeding!
'')')
ENDIF
IF(PLTCLSX) THEN ! Classic GXMONI
CALL GET_DEFAULT_PLOTTYPE(ITYPE,PCX_BACK)
LVAL=.FALSE.; CALL GETSDL('GXMONI','PLOTALL',LVAL)
IF(LVAL) THEN ! all four plots are saved
WRITE(LU,'(''
Convergence monitor plots'',
1 ''
'')')
WRITE(LU,
1 '(''
Spot value & Residual, Minimum ''
1 ,''& Maximum value, Maximum correction & Residual, Maximum '',
1 ''correction & Nett sum
'')')
ENDIF
ELSE ! New style GXMONI
CALL EAR_PLOTALL
WRITE(LU,'(''
Convergence monitor plots'',
1 ''
'')')
WRITE(LU,
1 '(''
Spot value, Residual, Maximum ''
1,'' value, Minimum value, Maximum correction, Nett source
'')')
WRITE(LU,'(''
'')')
OUTPUT='.png'
CALL REMSPC(OUTPUT,LENGZZ(OUTPUT))
WPNAM='convergence-spot'//OUTPUT(:LENGZZ(OUTPUT))
LL=LENGZZ(WPNAM)
WRITE(LU,'('''',
1 '' '')')
1 WPNAM(:LL),WPNAM(:LL)
C
WPNAM='convergence-residual'//OUTPUT(:LENGZZ(OUTPUT))
LL=LENGZZ(WPNAM)
WRITE(LU,'('''',
1 '' '')')
1 WPNAM(:LL),WPNAM(:LL)
C
WPNAM='convergence-domainMax'//OUTPUT(:LENGZZ(OUTPUT))
LL=LENGZZ(WPNAM)
WRITE(LU,'('''',
1 '' '')')
1 WPNAM(:LL),WPNAM(:LL)
C
WPNAM='convergence-domainMin'//OUTPUT(:LENGZZ(OUTPUT))
LL=LENGZZ(WPNAM)
WRITE(LU,'('''',
1 '' '')')
1 WPNAM(:LL),WPNAM(:LL)
C
WPNAM='convergence-maxCorrection'//OUTPUT(:LENGZZ(OUTPUT))
LL=LENGZZ(WPNAM)
WRITE(LU,'('''',
1 '' '')')
1 WPNAM(:LL),WPNAM(:LL)
C
WPNAM='convergence-netsources'//OUTPUT(:LENGZZ(OUTPUT))
LL=LENGZZ(WPNAM)
WRITE(LU,'('''',
1 '' '')')
1 WPNAM(:LL),WPNAM(:LL)
C
ENDIF
WRITE(LU,'(''
CPU time of run'',I8,
1 '' s
'')') ICPU
WRITE(LU,'('''')')
WRITE(LU,'('''')')
C... close file
CLOSE(LU,STATUS='KEEP',IOSTAT=IERR)
C... display in browser
IF(IERR==0) CALL START_BROWSER(FILNAM)
END
C---------------------------------------------------------------------------------
CHARACTER*(*) FUNCTION CHGR_GEN(RVAL)
USE Inf_NaN_Detection
CHARACTER*13 BUFF
IF(ISNAN(RVAL)) THEN
CHGR_GEN='NaN'
ELSEIF(ISINF(RVAL)) THEN
CHGR_GEN='Infinity'
ELSE
WRITE(BUFF,'(1PG12.3)') RVAL
CHGR_GEN=BUFF
ENDIF
END
'')')
!DEC$ ENDIF
C
ITIME(1)=-999
CALL MCLOCK(ITIME)
IY=ITIME(1); IM=ITIME(2); ID=ITIME(3); IH=ITIME(4); IMIN=ITIME(5)
IS=ITIME(6); LC=1; LINE=' '
ICPU=NINT(FLOAT((ITIME(19)+ITIME(20)))/1000.)
c
IF(IY==(-999)) THEN
OUTPUT=LINE
ELSE
c assemble time information
CALL NUM2(IH,CH2)
LINE(LC:LC+1)=CH2; LC=LC+2
LINE(LC:LC)=':'; LC=LC+1
CALL NUM2(IMIN,CH2)
LINE(LC:LC+1)=CH2; LC=LC+2
LINE(LC:LC)=':'; LC=LC+1
CALL NUM2(IS,CH2)
LINE(LC:LC+1)=CH2; LC=LC+2
LINE(LC:LC+3)=' on '; LC=LC+3
c calculate the day of the week
IF(MOD(IY,4)==0) IMONTH(2)=29
IREF=0
DO I=1983,IY
IREF=IREF+1
IF(MOD(I-1,4)==0) IREF=IREF+1
ENDDO
ISUM=0; I1=IM-1
DO I=1,I1
ISUM=ISUM+IMONTH(I)
ENDDO
ISUM=ISUM+ID+IREF
ISUM=MOD(ISUM,7)
IF(ISUM==0) ISUM=7
c glue together output buffer
LDAYT=LDAY(ISUM); LMONT=LMONTH(IM)
CALL NUM4(IY,CH4); CALL NUM2(ID,CH2)
OUTPUT=' '
OUTPUT(1:LC)=LINE(1:LC)
TEMLIN(1:9)=DAY(ISUM)
OUTPUT(LC+1:LDAYT+LC)=TEMLIN(1:LDAYT); LC=LC+LDAYT+1
OUTPUT(LC:LC+1)=', '; LC=LC+2
OUTPUT(LC:LC+1)=CH2; LC=LC+2
OUTPUT(LC:LC)=' '; LC=LC+1
TEMLIN(1:9)=MONTH(IM)
OUTPUT(LC:LC+LMONT-1)=TEMLIN(1:LMONT); LC=LC+LMONT
OUTPUT(LC:LC)=' ' ; LC=LC+1
OUTPUT(LC:LC+3)=CH4
ENDIF
BUF1=OUTPUT
IF(BUF1/=' ') THEN
WRITE(LU,'(''