! ! Copyright (C) 1991-2003 ; All Rights Reserved ; ATMET, LLC ! ! This file is free software; you can redistribute it and/or modify it under the ! terms of the GNU General Public License as published by the Free Software ! Foundation; either version 2 of the License, or (at your option) any later version. ! ! This software is distributed in the hope that it will be useful, but WITHOUT ANY ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A ! PARTICULAR PURPOSE. See the GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License along with this ! program; if not, write to the Free Software Foundation, Inc., ! 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. !====================================================================================== C----------------------------------------------------------------- C Program to make landuse files consistent with RAMS C version 4.4 and earlier. The routine will take a lat-lon array C of landuse values and reformat it into several smaller C files for input into the model. C C Note: This program must be run on a machine that supports the integer*1 data type. C----------------------------------------------------------------- ! Main program - modify to input your data into the "landuse" array. ! The input data must have the following characteristics: ! ! - defined on a regular lat-lon array where the lat and lon ! grid spacing is equal ! ! - landuse(1,1) is the southwest corner, proceeding row-wise ! ! - values are expected to be integers in the range of 0 to 255 ! (even though they will be put into a floating point array, ! they will be scaled in the called routine.) ! ! - values should be consistent with the OGE landuse types as defined by ! USGS. If not, translations must be implemented in the RAMS code. ! Note this program should be used for RAMS versions 6.0 and earlier. While RAMS v6.0 ! can use an HDF5 dataset, it will also read this older format. ! A new program will be made available to create the HDF5 files. program make_landuse real landuse(100,200) integer*1 scr(100000) ! Example read statement open(30,file='./my_latlon_data.dat',status='old' + ,form='unformatted') read(30) landuse ! Test code, fill in dummy values !do j=1,200 ! do i=1,100 ! landuse(i,j)=i*j ! enddo !enddo offlat=0. offlon=0. call mkluse(8,10,landuse,-110,40,1.,2,'T',SCR,offlat,offlon) END C C Input parameters: C C NX - Number of x (longitude) gripoints in input array (LANDUSE) C NY - Number of y (latitude) gripoints in input array (LANDUSE) C LANDUSE - Input latitude-logitude array of topography heights C in meters. C IWLON - West longitude of LANDUSE (-180 to 180 degrees) C ISLAT - South latitude of LANDUSE (-90 to 90 degrees) C TRES - TOPO resolution in degrees C IBLSIZE- Size in degrees of output files (they will have the C same number of points in x and y. C FPREF - File name prefix for output files (can include path) C SCR - Scratch array of at least (IBLSIZE/TRES+1)**2 C OFFLAT - lat offset if data is not aligned exactly on integer degree points C OFFLON - lon offset if data is not aligned exactly on integer degree points C C Note that IWLON, ISLAT, and IBLSIZE are all integers. C------------------------------------------------------------------------- SUBROUTINE MKLUSE(NX,NY,LANDUSE,IWLON,ISLAT,TRES,IBLSIZE,FPREF,SCR + ,offlat,offlon) CHARACTER*(*) FPREF REAL LANDUSE(NX,NY) integer*1 SCR(*) CHARACTER*80 TITLE1,TITLE2,TITLE3 IBLDIM=INT(FLOAT(IBLSIZE)/TRES+.001)+1 NSQX=NX/(IBLDIM-1) NSQY=NY/(IBLDIM-1) cccccccccccc TITLE3=trim(FPREF)//'HEADER' OPEN(29,STATUS='NEW',FILE=TITLE3,FORM='FORMATTED') PRINT*, 'Making file-',trim(TITLE3) WRITE(29,14)IBLSIZE,IBLDIM,ISLAT,IWLON,offlat,offlon 14 FORMAT(4I5,2f10.6) CLOSE(29) cccccccccccc DO 1 NSX=1,NSQX DO 2 NSY=1,NSQY I=(NSX-1)*(IBLDIM-1)+1 J=(NSY-1)*(IBLDIM-1)+1 LAT=ISLAT+(NSY-1)*IBLSIZE LON=IWLON+(NSX-1)*IBLSIZE LATT=ABS(LAT)/10 LATO=ABS(LAT)-LATT*10 LONH=ABS(LON)/100 LONT=(ABS(LON)-LONH*100)/10 LONO=ABS(LON)-LONH*100-LONT*10 IF(LAT.GE.0)THEN WRITE(TITLE1,'(2I1,A1)')LATT,LATO,'N' ELSE WRITE(TITLE1,'(2I1,A1)')LATT,LATO,'S' ENDIF IF(LON.GE.0)THEN WRITE(TITLE2,'(3I1,A1)')LONH,LONT,LONO,'E' ELSE WRITE(TITLE2,'(3I1,A1)')LONH,LONT,LONO,'W' ENDIF TITLE3=trim(FPREF)//TITLE1(1:3)//TITLE2(1:4) PRINT*, NSX,NSY,i,j,LAT,LON PRINT*, 'Making file-',trim(TITLE3) NPT=1 DO 10 JJ=J,(IBLDIM-1)+J DO 11 II=I,(IBLDIM-1)+I SCR(NPT)=int(LANDUSE(II,JJ)+.1) NPT=NPT+1 11 CONTINUE 10 CONTINUE OPEN(29,STATUS='NEW',FILE=TITLE3,FORM='UNFORMATTED') write(29) scr(1:npt) CLOSE(29) 2 CONTINUE 1 CONTINUE END