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