C **** C **** THIS PROGRAM DEFINES ALL THE PARAMETERS TO SPECIFY C **** THE NESTED GRID DOMAIN. FOR EACH LEVEL OF NESTING, C **** THREE *.h FILES AND ONE DATA FILES ARE CREATED: C **** 1. nxparam.h: Index for array dimensions C **** 2. nxnestg.h: Parameters for nested grid lateral C **** boundary conditions C **** 3. nestcnt.h: Parameters to define nested grid C **** domains. This data file is read C **** by tieng_start.f. C **** 4. nestsrt.dat: Start time, End time, and Number of C **** Time Steps for each nesting level. C **** C **** ----July, 1999 Wenbin Wang C **** CHARACTER*80 ANSW CHARACTER*1 X CHARACTER*7 NESTG CHARACTER*9 PARAM_NAME(4),NESTG_NAME(4) DIMENSION NSLAT(4),NELAT(4),NSLON(4),NELON(4),NRATIO(4),ILATS(4), 1 ILONS(4),MLATS(4),MLONS(4),MEDAY(4),MEHOR(4),MEMIN(4), 2 MSDAY(4),MSHOR(4),MSMIN(4),ITERN(4),NSTIME(4), 3 NETIME(4),MTIME(4) C **** C **** INPUT FOR NUMBER OF NESTED GRID LEVELS C **** WRITE(6,"(' ***************')") WRITE(6,"(' ***************')") WRITE(6,"(' ***************')") 1000 CONTINUE WRITE(6,"(/,' Please enter LEVELS of the nested grids', + /,' (1--4, no default):',$)") CALL GETANS(ANSW) NLEVEL=IGET(ANSW,IER) IF(NLEVEL.LT.1.OR.NLEVEL.GT.4)THEN WRITE(6,*) WRITE(6,"('>>> Invalid input of nested grid levels <<<')") WRITE(6,"('Please try again, Levels should be between 1 and 4')") WRITE(6,"('Your Input Was',I6)")NLEVEL WRITE(6,*) GOTO 1000 ENDIF C **** C **** BEGIN TO DEFINE NESTED GRID DOMAINS C **** 801 FORMAT(I1) DO N=1, NLEVEL C **** C **** NAMES OF THE OUTPUT FILES C **** WRITE(X,801)N PARAM_NAME(N)='nxparam.h' NESTG_NAME(N)='nxnestg.h' PARAM_NAME(N)(2:2)=x NESTG_NAME(N)(2:2)=x C ***** C ***** INPUT SATARTING LATITUDES OF THE NESTED GRID C ***** DOMAINS. THESE VALUES ARE CORRESPONDENT TO C ***** GLOBAL COARSE GRID INDICES C ***** 1001 CONTINUE IF(N.EQ.1)THEN WRITE(6,"(/,' Please enter the Starting Latitude Grid Number ',I1, + /,' (1--35 no default):',$)")N ELSE WRITE(6,"(/,' Please enter the Starting Latitude Grid Number ',I1, + /,' (1 -- ',I3,' no default):',$)")N,MLATS(N-1)-1 ENDIF CALL GETANS(ANSW) NSLAT(N)=IGET(ANSW,IER) IF(N.EQ.1)THEN IF(NSLAT(N).LT.1.OR.NSLAT(N).GE.36)THEN WRITE(6,"('>>> Invalid input for Starting Latitude Grid', + ' Number',I6)")NSLAT(N) WRITE(6,"('Your Input should between 1 and 35')") GOTO 1001 ENDIF ELSE IF(NSLAT(N).LT.1.OR.NSLAT(N).GE.MLATS(N-1))THEN WRITE(6,"('>>> Invalid input for Starting Latitude Grid', + ' Number',I6)")NSLAT(N) WRITE(6,"('Your Input should smaller than ',I6)") + MLATS(N-1)-1 GOTO 1001 ENDIF ENDIF C ***** C ***** INPUT ENDDING LATITUDES OF THE NESTED GRID C ***** DOMAINS. THESE VALUES ARE CORRESPONDENT TO C ***** GLOBAL COARSE GRID INDICES C ***** 1002 CONTINUE IF(N.EQ.1)THEN WRITE(6,"(/,' Please enter the Ending Latitude Grid Number ',I1, + /,' (2--36 no default):',$)")N ELSE WRITE(6,"(/,' Please enter the Ending Latitude Grid Number ',I1, + /,' (',I3,' -- ',I3,' no default):',$)")N,NSLAT(N)+1, + MLATS(N-1) ENDIF CALL GETANS(ANSW) NELAT(N)=IGET(ANSW,IER) IF(N.EQ.1)THEN IF(NELAT(N).LT.NSLAT(N).OR.NELAT(N).GE.36)THEN WRITE(6,"('>>> Invalid input for Ending Latitude Grid', + ' Number',I6)")NELAT(N) WRITE(6,"('Your Input should between ',I3,' and 36')")NSLAT(N) GOTO 1002 ENDIF ELSE IF(NELAT(N).GT.MLATS(N-1).OR.NELAT(N).LT.NSLAT(N))THEN WRITE(6,"('>>> Invalid input for Starting Latitude Grid', + ' Number',I6)")NELAT(N) WRITE(6,"('Your Input should smaller than or equal to',I6)") + MLATS(N-1) WRITE(6,"('Your Input should greater than or equal to',I6)") + NSLAT(N)+1 GOTO 1002 ENDIF ENDIF C ***** C ***** INPUT NESTING RATIOS FOR EACH NESTING LEVEL C ***** 1003 CONTINUE WRITE(6,"('Please Input Nesting Ratio for Nesting Level', + ' number ',I1,' (default is 3):',$)")N CALL GETANS(ANSW) IF(ANSW(1:1).EQ.' ')THEN NRATIO(N)=3 ELSE NRATIO(N)=IGET(ANSW,IER) ENDIF IF(NRATIO(N).LT.2.OR.NRATIO(N).GT.3)THEN WRITE(6,"('Nesting Ratio Should Be 2 OR 3')") WRITE(6,"('Your Input was ',I1)")NRATIO(N) GOTO 1003 ENDIF C ***** C ***** CALCULATE NUMBER OF GRID POINTS IN LATITUDE AND C ***** LONGITUDE FOR EACH NESTING LEVEL C ***** ILATS(N)=NELAT(N)-NSLAT(N)+1 MLATS(N)=(NELAT(N)-NSLAT(N))*NRATIO(N)+1 ENDDO C ***** C ***** INPUT SATARTING LONGITUDES OF THE NESTED GRID C ***** DOMAINS. THESE VALUES ARE CORRESPONDENT TO C ***** GLOBAL COARSE GRID INDICES C ***** 2000 CONTINUE DO N=1,NLEVEL 2001 CONTINUE IF(N.EQ.1)THEN WRITE(6,"(/,'Please enter the Starting Longitude Grid Number ',I1, + /,' (3--73 no default):',$)")N ELSE WRITE(6,"(/,'Please enter the Starting Longitude Grid Number ',I1, + /,' (1 -- ',I3,' no default):',$)")N,MLONS(N-1)-1 ENDIF CALL GETANS(ANSW) NSLON(N)=IGET(ANSW,IER) IF(N.EQ.1)THEN IF(NSLON(N).LT.3.OR.NSLON(N).GE.74)THEN WRITE(6,"('>>> Invalid input for Starting Longitude Grid', + ' Number',I6)")NSLON(N) WRITE(6,"('Your Input should between 3 and 74')") GOTO 2001 ENDIF ELSE IF(NSLON(N).LT.1.OR.NSLON(N).GE.MLONS(N-1))THEN WRITE(6,"('>>> Invalid input for Starting Longitude Grid', + ' Number',I6)")NSLON(N) WRITE(6,"('Your Input should smaller than ',I6)")MLONS(N-1) GOTO 2001 ENDIF ENDIF C ***** C ***** INPUT ENDDING LONGITUDES OF THE NESTED GRID C ***** DOMAINS. THESE VALUES ARE CORRESPONDENT TO C ***** GLOBAL COARSE GRID INDICES C ***** 2002 CONTINUE IF(N.EQ.1)THEN WRITE(6,"(/,' Please enter the Ending Longitude Grid Number ',I1, + /,' (4--74 no default):',$)")N ELSE WRITE(6,"(/,' Please enter the Ending Longitude Grid Number ',I1, + /,' (',I3,' -- ',I3,' no default):',$)")N,NSLON(N), + MLONS(N-1) ENDIF CALL GETANS(ANSW) NELON(N)=IGET(ANSW,IER) IF(N.EQ.1)THEN IF(NELON(N).LT.NSLON(N).OR.NELON(N).GE.74)THEN WRITE(6,"('>>> Invalid input for Ending Longitude Grid', + ' Number',I6)")NELON(N) WRITE(6,"('Your Input should between ',I3,' and 74')")NSLON(N) GOTO 2002 ENDIF ELSE IF(NELON(N).GT.MLONS(N-1).OR.NELON(N).LT.NSLON(N))THEN WRITE(6,"('>>> Invalid input for Starting Longitude Grid', + ' Number',I6)")NELON(N) WRITE(6,"('Your Input should smaller than or equal to',I6)") + MLONS(N-1)-1 WRITE(6,"('Your Input should greater than or equal to',I6)") + NSLON(N)+1 GOTO 2002 ENDIF ENDIF C ***** C ***** CALCULATE NUMBER OF GRID POINTS IN LATITUDE AND C ***** LONGITUDE FOR EACH NESTING LEVEL C ***** ILONS(N)=NELON(N)-NSLON(N)+1 MLONS(N)=(NELON(N)-NSLON(N))*NRATIO(N)+1 ENDDO C ***** C ***** CHECK IF DEFINED NESTED GRID DOMAINS ARE RIGHT C ***** write(6,*) write(6,*) WRITE(6,"('**********************************************')") WRITE(6,"('FOLLOWING ARE YOUR NESTED GRID DOMAINS')") write(6,*) WRITE(6,"('Levels of Nesting Are:',I1)")NLEVEL write(6,"(' Level SLAT ELAT MLAT SLON ELON MLON RATIO')") DO N=1,NLEVEL WRITE(6,111)N,NSLAT(N),NELAT(N),MLATS(N),NSLON(N),NELON(N), 1MLONS(N),NRATIO(N) ENDDO 111 format(8I6) WRITE(6,"('Do You Want to Change Your Configurations?:',$)") CALL GETANS(ANSW) IF(ANSW(1:1).EQ.'Y'.OR.ANSW(1:).EQ.'y')GOTO 1000 C ***** C ***** WRITE TO OUTPUT FILES C ***** DO N=1,NLEVEL OPEN(12,FILE=PARAM_NAME(N),STATUS='UNKNOWN') WRITE(12,"('C ****')") WRITE(12,"('C **** THIS FILE DEFINES THE PARAMETERS', 1 ' USED IN THE NESTED')") WRITE(12,"('C **** GRID MODEL')") WRITE(12,"('C ****')") WRITE(12,"(' IMPLICIT REAL*8(A-H,O-Z)')") WRITE(12,"('C ****')") WRITE(12,"('C **** CONTROL THE SPATIAL DIMENSIONS OF', 1 'THE NESTED GRID MODEL')") WRITE(12,"('C ****')") WRITE(12,"(' PARAMETER (IMX=',I3,',JMX=',I3,',KMX=24)')") 1 MLONS(N),MLATS(N) WRITE(12,"('C ****')") WRITE(12,"('C **** INCLUDE THE HEIGHT AT THE TOP AND ', 1 'BOTTOM IN PRESSURE')") WRITE(12,"('C **** UNITS')") WRITE(12,"('C ****')") WRITE(12,"(' PARAMETER (ST=5.,SB=-7.)')") WRITE(12,"('C ****')") WRITE(12,"('C **** MAXIMUM NUMBER OF CLUMNS PER BUFFER,', 1 ' FOR THE NPHYS')") WRITE(12,"('C **** VARIABLE AND FOR THE DATA BUFFER')") WRITE(12,"('C ****')") WRITE(12,"(' PARAMETER (IFLDX=745,IPHYX=850,IDATX=155)')") WRITE(12,"('C ****')") WRITE(12,"('C **** PARAMETER FOR THE F ARRAY')") WRITE(12,"('C ****')") WRITE(12,"(' PARAMETER (ISPES=8*IFLDX+IPHYX+2*IDATX)')") WRITE(12,"('C ****')") WRITE(12,"('C **** PARAMETER FOR HOUGH FUNCTION')") WRITE(12,"('C ****')") WRITE(12,"(' PARAMETER (IMX2=72,JMX2=36,KMX2=24,IMX4=76)')") WRITE(12,"('C ****')") WRITE(12,"('C **** OTHER DIMENSION PARAMETERS')") WRITE(12,"('C ****')") WRITE(12,"(' PARAMETER(KMXP=KMX+1,IMXP2=IMX+2,JMX3=108)')") CLOSE(12) OPEN(12,FILE=NESTG_NAME(N),STATUS='UNKNOWN') WRITE(12,"('C ****')") WRITE(12,"('C **** DIMENSIONS FOR COARSE AND FINE GRID')") WRITE(12,"('C ****')") WRITE(12,"(' PARAMETER(INX=',I2,',JNX=',I2,',NNX=',I3, 1 ',NJX=',I3,',NVR=575)')")ILONS(N),ILATS(N),MLONS(N), 2 MLATS(N) WRITE(12,"('C ****')") WRITE(12,"('C **** BOUNDARY VALUES FROM COARSE GRID')") WRITE(12,"('C ****')") WRITE(X,801)N NESTG='NESTGC ' NESTG(7:7)=X WRITE(12,"(' COMMON/',A7,'/PHI1(INX,NVR,2),', 1 /' 1 PHI2(JNX,NVR,2),', 2 /' 2 PHI3(INX,NVR,2),', 3 /' 3 PHI4(JNX,NVR,2)')")NESTG WRITE(12,"('C ****')") WRITE(12,"('C **** BOUNDARY VALUES FROM FINE GRID')") WRITE(12,"('C ****')") NESTG(6:6)='F' WRITE(12,"(' COMMON/'A7,'/FIN1(NNX,NVR,2),', 1 /' 1 FIN2(NJX,NVR,2),', 2 /' 2 FIN3(NNX,NVR,2),', 3 /' 3 FIN4(NJX,NVR,2)')")NESTG CLOSE(12) ENDDO OPEN(12,FILE='nestcnt.h',STATUS='UNKNOWN') WRITE(12,"('C ****')") WRITE(12,"('C **** DEFINE FINE GRID')") WRITE(12,"('C ****')") WRITE(12,"(' COMMON/NESTC/NESTL,NESTRI(4),NESTRJ(4),')") WRITE(12,"(' 1 NESTUN(4),NESTIN(4),')") WRITE(12,"(' 4 NESTJ1(4),NESTJM(4),')") WRITE(12,"(' 5 NESTI1(4),NESTIM(4)')") WRITE(12,"(' CHARACTER*5 NESTIN')") CLOSE(12) OPEN(12,FILE='nestsrt.dat',STATUS='UNKNOWN') WRITE(12,"(' DATA NESTL/',I1,'/')")NLEVEL WRITE(12,"(' DATA NESTRI/',I1,',',I1,','I1,',',I1,'/')") 1 NRATIO(1),NRATIO(2),NRATIO(3),NRATIO(4) WRITE(12,"(' DATA NESTRJ/',I1,',',I1,','I1,',',I1,'/')") 1 NRATIO(1),NRATIO(2),NRATIO(3),NRATIO(4) WRITE(12,"(' DATA NESTUN/21,22,23,24/')") WRITE(12,"(' DATA NESTJ1/',I2,',',I2,','I2,',',I2,'/')") 1 NSLAT(1),NSLAT(2),NSLAT(3),NSLAT(4) WRITE(12,"(' DATA NESTJM/',I2,',',I2,','I2,',',I2,'/')") 1 NELAT(1),NELAT(2),NELAT(3),NELAT(4) WRITE(12,"(' DATA NESTI1/',I2,',',I2,','I2,',',I2,'/')") 1 NSLON(1),NSLON(2),NSLON(3),NSLON(4) WRITE(12,"(' DATA NESTIM/',I2,',',I2,','I2,',',I2,'/')") 1 NELON(1),NELON(2),NELON(3),NELON(4) WRITE(12,"(' DATA NESTIN/''nein1'',''nein2'',''nein3'',''ne', 1 'in4''/')") C ***** C ***** INPUT START TIMES FOR EACH NESTING LEVEL C ***** 4000 CONTINUE DO N=1,NLEVEL 4001 CONTINUE WRITE(6,*) WRITE(6,"('*** Please Input START Time for LEVEL ',I1,' ***')")N WRITE(6,"('---Model Day:',$)") READ(5,"(a)") ANSW READ(ANSW,*)MSDAY(N) WRITE(6,"('---Model Hour:',$)") READ(5,"(a)") ANSW READ(ANSW,*)MSHOR(N) WRITE(6,"('---Model Minute:',$)") READ(5,"(a)") ANSW READ(ANSW,*)MSMIN(N) NSTIME(N)=(MSDAY(N)*24+MSHOR(N))*60+MSMIN(N) WRITE(6,*) WRITE(6,"('*** Please Input END Time for LEVEL ',I1,' ***')")N WRITE(6,"('---Model Day:',$)") READ(5,"(a)") ANSW READ(ANSW,*)MEDAY(N) WRITE(6,"('---Model Hour:',$)") READ(5,"(a)") ANSW READ(ANSW,*)MEHOR(N) WRITE(6,"('---Model Minute:',$)") READ(5,"(a)") ANSW READ(ANSW,*)MEMIN(N) NETIME(N)=(MEDAY(N)*24+MEHOR(N))*60+MEMIN(N) IF(NETIME(N).LE.NSTIME(N))THEN WRITE(6,"('END Time',I6,' is Ahead of Start Time',I6)") 1 NETIME(N),NSTIME(N) WRITE(6,"('Please Try Again')") WRITE(6,*) GOTO 4001 ENDIF IF(N.NE.1)THEN IF(NETIME(N).GT.NETIME(N-1).OR.NSTIME(N).LT.NSTIME(N-1))THEN WRITE(6,"(' <<<<<<< WARNING >>>>>>>')") WRITE(6,"('TIME SEQUENCE IS NOT RIGHT FOR LEVELS ',I1,' AND ', 1 I1)")N,N-1 WRITE(6,"('Please Try Again')") WRITE(6,*) GOTO 4000 ENDIF ENDIF ENDDO C ***** C ***** CHECK TIME STEPS FOR EACH NESTING LEVEL C ***** WRITE(6,"('Please Input the Time Step of the Global Model:',$)") CALL GETANS(ANSW) KTIME=IGET(ANSW,IER) MTIME(1)=NRATIO(1) IF(NLEVEL.GE.2)THEN DO N=2,NLEVEL MTIME(N)=MTIME(N-1)*NRATIO(N) ENDDO ENDIF DO N=1,NLEVEL NTIME=(NETIME(N)-NSTIME(N))*60 ITERN(N)=NTIME*MTIME(N)/KTIME IF(MOD(NTIME*MTIME(N),KTIME).NE.0)THEN WRITE(6,"('ERROE: End-Start Time is not a Multiple of', 1 'Time Step')")NTIME*MTIME(N),KTIME GOTO 4000 ENDIF ENDDO WRITE(12,"(' *** MODEL START TIME ***')") WRITE(12,"(' LEVEL DAY HOUR MINUTE')") DO N=1,NLEVEL WRITE(12,112)N,MSDAY(N),MSHOR(N),MSMIN(N) ENDDO WRITE(12,"(' *** MODEL START TIME ***')") WRITE(12,"(' LEVEL DAY HOUR MINUTE')") DO N=1,NLEVEL WRITE(12,112)N,MEDAY(N),MEHOR(N),MEMIN(N) ENDDO DO N=1,NLEVEL WRITE(12,113)ITERN(N) ENDDO 112 FORMAT(4I6) 113 FORMAT(I8) STOP END C SUBROUTINE GETANS(ANS) CHARACTER*(*) ANS READ(5,"(A)")ANS RETURN END C INTEGER FUNCTION IGET(STR,IER) CHARACTER*(*) STR PARAMETER (TOOBIG=2147483647.,TOOSMALL=-2147483648.) IER=0 READ(STR,*,ERR=900)R IF(R.GT.TOOBIG.OR.R.LT.TOOSMALL)THEN IER=1 RETURN ENDIF IGET=IFIX(R) RETURN 900 IER=2 RETURN END