C **********************************************************************
C * *
C * SOFTWARE LICENSING *
C * *
C * This program is free software; you can redistribute *
C * it and/or modify it under the terms of the GNU *
C * General Public License as published by the Free *
C * Software Foundation, either Version 2 of the *
C * license, or (at your option) any later version. *
C * *
C * This program is distributed in the hope that it *
C * will be useful, but without any warranty; without *
C * even the implied warranty of merchantability or *
C * fitness for a particular purpose. See the GNU *
C * General Public License for more details. *
C * *
C * A copy of the GNU General Public License is *
C * available at http://www.gnu.org/copyleft/gpl.html *
C * or by writing to the Free Software Foundation, Inc.,*
C * 59 Temple Place - Suite 330, Boston, MA 02111, USA. *
C * *
C **********************************************************************
SUBROUTINE RDCORLOC
C This program reads corner_loc a file with the corners of each cell
C stores corners in XCORNER,YCORNER, and cell centroids in
C XGRID,YGRID (by simple division by four for now).
C
C XCORNER,YCORNER are by definition IM+1,JM+1 ARRAYS.
C CORNER LOCATION CONVENTION: XCORNER(I,J) = XGRID(i-1/2, j-1/2)
C (LOWER LEFT-HAND CORNER) YCORNER(I,J) = YGRID(i-1/2, j-1/2)
C
C NOTE: IF corner_loc is not provided, corners will be created
C for the model space in the above convention, and centroids
C will be read in from model_grid.
C
C (Stevens Institute of Technology)
C March 26, 2008
Include 'comdeck'
INTEGER IJUNK,JJUNK,NUMB
REAL RJUNK
DIMENSION COM(80)
CNG Read corners
OPEN(51,FILE='corner_loc',STATUS='OLD',ERR=333)
WRITE(IUPRT,*) '***********************************'
WRITE(IUPRT,*) 'Reading corners from corner_loc. '
WRITE(IUPRT,*) '***********************************'
DO K=1,(IM+1)*(JM+1) ! NG07252007
READ(51,'(2i5,2f12.5)',err=899,end=899)I,J,
+ XCORNER(I,J),YCORNER(I,J)
END DO
899 CONTINUE
CNG Create simple centroids
DO J = 1, JM
DO I = 1 , IM
IF (FSM(I,J).NE.0) THEN
XGRID(I,J)=(XCORNER(I,J)+
+ XCORNER(I+1,J)+
+ XCORNER(I+1,J+1)+
+ XCORNER(I,J+1))/4.
YGRID(I,J)=(YCORNER(I,J)+
+ YCORNER(I+1,J)+
+ YCORNER(I+1,J+1)+
+ YCORNER(I,J+1))/4.
ELSE
XGRID(I,J)=-99999. ! NG03312009 PUTCDF FIX
YGRID(I,J)=-99999. ! TO FLAG LAND VALUES
ENDIF
END DO
END DO
CLOSE(51)
RETURN
333 CLOSE(51)
WRITE(IUPRT,*) '**********************************************'
WRITE(IUPRT,*) 'No corner_loc file found. Set to model space. '
WRITE(IUPRT,*) 'For centers, the model_grid file will be used.'
WRITE(IUPRT,*) '**********************************************'
DO J=1,JM+1
DO I=1,IM+1
XCORNER(I,J)=FLOAT(I)-0.5
YCORNER(I,J)=FLOAT(J)-0.5
END DO
END DO
DO J=1,JM
DO I=1,IM
XGRID(I,J)=0.0
YGRID(I,J)=0.0
END DO
END DO
OPEN(51,FILE='model_grid',err=900)
READ(51,11) (COM(I),I=1,80)
READ(51,11) (COM(I),I=1,80)
READ(51,4) IJUNK
IF(IJUNK.NE.KB) THEN
WRITE(IUPRT,42) IJUNK,KB
CALL SYSTEM ('rm gcm_temp*')
STOP
ENDIF
DO 140 K=1,KB
READ(51,5) RJUNK
140 CONTINUE
READ(51,11) (COM(I),I=1,80)
READ(51,7) IJUNK, JJUNK
IF(IJUNK.NE.IM) THEN
WRITE(IUPRT,8) IJUNK,IM
CALL SYSTEM ('rm gcm_temp*')
STOP
ENDIF
IF(JJUNK.NE.JM) THEN
WRITE(IUPRT,9) JJUNK,JM
CALL SYSTEM ('rm gcm_temp*')
STOP
ENDIF
NUMB=IM*JM
DO 100 N=1,NUMB
READ(51,91,err=101,end=101)
+ I,J,RJUNK,RJUNK,RJUNK,RJUNK,YGRID(I,J),XGRID(I,J),RJUNK
100 CONTINUE
101 CONTINUE
CLOSE(51)
4 FORMAT(I5)
5 FORMAT(8F10.5)
7 FORMAT(2I5,6F10.2)
8 FORMAT (//' MODEL_GRID I-INDEX',I5,' (IIX)',/
+ ' DOES NOT EQUAL'/
+ ' COMDECK I-INDEX',I5,' (IM)'/
+ ' PLEASE CORRECT THIS PROBLEM AND TRY AGAIN'//)
9 FORMAT (//' MODEL_GRID J-INDEX',I5,' (IJY)',/
+ ' DOES NOT EQUAL'/
+ ' COMDECK J-INDEX',I5,' (JM)'/
+ ' PLEASE CORRECT THIS PROBLEM AND TRY AGAIN'//)
11 FORMAT(80A1)
42 FORMAT(//' NUMBER OF SIGMA LEVELS IN MODEL_GRID',I5,' (IKB)'/
+ ' NOT EQUAL TO'/
+ ' NUMBER OF SIGMA LEVELS IN COMDECK ',I5,' (KB)'/
+ ' PLEASE CORRECT THIS PROBLEM AND TRY AGAIN'//)
71 FORMAT(' IM = ',I5,/' JM = ',I5)
91 FORMAT(2I5,4F10.2,2F10.5,f5.1)
RETURN
900 CONTINUE ! No model_grid file found
WRITE(IUPRT,*) '**********************************************'
WRITE(IUPRT,*) 'NO MODEL_GRID FILE FOUND. PLEASE READ BELOW: '
WRITE(IUPRT,*) 'Centroids of cells are used to compute tidal '
WRITE(IUPRT,*) 'constituents and in 2D solar heat flux and '
WRITE(IUPRT,*) 'cloud cover computations. If you use any of '
WRITE(IUPRT,*) 'these options, the model_grid or corner_loc '
WRITE(IUPRT,*) 'files are required for physically correct '
WRITE(IUPRT,*) 'results. '
WRITE(IUPRT,*) '**********************************************'
RETURN
END