| 1 |
C $Id: get_map.F,v 1.1 1997/06/11 05:20:53 cnh Exp $ |
| 2 |
#include "CPP_OPTIONS.h" |
| 3 |
#include "CPP_MACROS.h" |
| 4 |
|
| 5 |
C/-------------------------------------------------------------------\ |
| 6 |
C||| Procedure: GET_MAP ||| |
| 7 |
C|||===============================================================||| |
| 8 |
C||| Function: Loads two dimensional (XY) general map. ||| |
| 9 |
C||| Comments: ||| |
| 10 |
C\-------------------------------------------------------------------/ |
| 11 |
CStartofinterface |
| 12 |
SUBROUTINE GET_MAP ( |
| 13 |
I mapFile, IOUNIT, |
| 14 |
O basinMask, |
| 15 |
I Nx, Ny, Nmax, Nb, |
| 16 |
U iErr ) |
| 17 |
IMPLICIT NONE |
| 18 |
C /--------------------------------------------------------------\ |
| 19 |
C | Global data | |
| 20 |
C |==============================================================| |
| 21 |
C | ** NONE ** | |
| 22 |
C \--------------------------------------------------------------/ |
| 23 |
C /--------------------------------------------------------------\ |
| 24 |
C | Routine arguments | |
| 25 |
C |==============================================================| |
| 26 |
C | mapFile - Name of file from which map will be read. | |
| 27 |
C | IOUNIT - Unit number for reading mapFile | |
| 28 |
C | basinMask - Array into which mask will be read. | |
| 29 |
C | Nx, Ny, Nmax - Size of basinMask. | |
| 30 |
C | Nb - Index of the basin being read. | |
| 31 |
C | iErr - Error flag. | |
| 32 |
C \--------------------------------------------------------------/ |
| 33 |
CHARACTER*(*) mapFile |
| 34 |
INTEGER IOUNIT |
| 35 |
INTEGER Nx |
| 36 |
INTEGER Ny |
| 37 |
INTEGER Nmax |
| 38 |
REAL basinMask(Nx,Ny,Nmax) |
| 39 |
INTEGER Nb |
| 40 |
INTEGER iErr |
| 41 |
CEndofinterface |
| 42 |
C /--------------------------------------------------------------\ |
| 43 |
C | Local variables | |
| 44 |
C |==============================================================| |
| 45 |
C | RECORD - I/O Buffer. | |
| 46 |
C | NREC, I, I1, J, I2 - Loop counters | |
| 47 |
C \--------------------------------------------------------------/ |
| 48 |
CHARACTER*1024 RECORD |
| 49 |
INTEGER NREC |
| 50 |
INTEGER I, I1 |
| 51 |
INTEGER J, I2 |
| 52 |
C |
| 53 |
IF ( Nx .GT. 1024 ) GOTO 999 |
| 54 |
OPEN(IOUNIT,FILE=mapFile,STATUS='OLD',ERR=998) |
| 55 |
NREC = 0 |
| 56 |
I2 = Ny+1 |
| 57 |
3 CONTINUE |
| 58 |
READ ( IOUNIT, '(A1024)', END = 4 ) RECORD |
| 59 |
NREC = NREC+1 |
| 60 |
C Skip commented lines |
| 61 |
IF (RECORD(1:1) .EQ. '#' ) GOTO 3 |
| 62 |
C Skip blank lines at the end of the file |
| 63 |
IF ( I2 .EQ. 1 .AND. RECORD .EQ. ' ' ) GOTO 3 |
| 64 |
I2 = I2 - 1 |
| 65 |
IF ( I2 .LT. 1 ) GOTO 4 |
| 66 |
READ (RECORD,'(1024F1.0)',ERR=997) basinMask(:,I2,Nb) |
| 67 |
GOTO 3 |
| 68 |
4 CONTINUE |
| 69 |
IF ( I2 .NE. 1 ) GOTO 996 |
| 70 |
CLOSE(IOUNIT) |
| 71 |
C Map loaded O.K. |
| 72 |
|
| 73 |
1000 CONTINUE |
| 74 |
RETURN |
| 75 |
999 CONTINUE |
| 76 |
iErr = 1 ! Buffer too small |
| 77 |
GOTO 1000 |
| 78 |
998 CONTINUE |
| 79 |
iErr = 2 ! Error opening file |
| 80 |
GOTO 1000 |
| 81 |
997 CONTINUE |
| 82 |
iErr = 3 ! Error reading file |
| 83 |
CLOSE(IOUNIT) |
| 84 |
GOTO 1000 |
| 85 |
996 CONTINUE |
| 86 |
iErr = 4 ! Incorrect number of records in map file. |
| 87 |
GOTO 1000 |
| 88 |
END |
Parent Directory
| 
Revision Log
| 
Revision Graph