C ********************************************************************** C * THIS PROGRAM IS USED TO READ BINARY DATA FILES AND EXTRACT * C * THE APPROPRIATE VARIABLES FOR PLOTTING. * C * OUTPUT IS TAB DELIMITED FILES * C * * C * CREATED 11-JUL-89 BY WAYNE GIBSON * C * PRINCIPAL INVESTIGATOR : LARRY MAHRT * C * RESEARCH ASSOCIATE : MIKE EK * C * OREGON STATE UNIVERSITY * C * DEPARTMENT OF OCEANIC AND ATMOSPHERIC SCIENCES * C * CORVALLIS, OREGON 97331-2209 * C * (503) 7375701 * C * Internet : ek@ats.orst.edu * C * gibson@.ats.orst.edu * C ********************************************************************** C * This program should run on any platform with little or no changes. * C MODIFICATIONS: C CHANGE 'NMAXOB' AS IN THE PARAMETER STATEMENT BELOW IF YOU WANT MORE C OBSERVATION EXTRACTED. 800 IS TYPICALLY TOO BIG FOR IBM PC'S C PARAMETER (NUMVAR=18,nr=7,NMAXOB=800,NALTIM=25) C ********************************************************************** C ::::::::::::::::::::: SUBROUTINES :::::::::::::::::::::::::::: C : ----------------------------------- : C : SUBROUTINES INTERNAL TO THE PROGRAM : C : ----------------------------------- : C : HEADER - READS THE HEADER PORTION (INITIAL MODEL PARAMETERS) : C : OF THE BINARY MODEL OUTPUT : C : IFLAGS - READS FLAGS THAT CONTROL PLOTTING PROGRAM : C : ECHK - INITAL ERROR CHECKING OF INPUT FLAGS : C : RTS - READS TIME SERIES DATA AND CALLS APPROPRIATE PLOTTING : C : ROUTINES FOR TIME SERIES DATA : C : RPROF - READS PROFILE DATA AND CALLS APPROPRIATE PLOTTING ROUTINES : C : FOR PROFILE DATA : C : TIMEP - FOR TIME SERIES DATA, SETS UP THE TEXT LABELS, PLOTTING : C : RANGES, AND PASSES THE INFORMATION TO SUBROUTINE PLOT : C : PROFLE - FOR PROFILE DATA, SETS UP THE TEXT LABELS, PLOTTING : C : RANGES, AND PASSES THE INFORMATION TO SUBROUTINE PLOT : C :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: C : PROGRAM VARIABLES : C : ----------------- : C : NUMVAR = ALLOCATED MAXIMUM (NUMBER OF PROFILE VARIABLES OR : C : NUMBER OF TIME SERIES RECORDS) : C : NUMTIM = ALLOCATED NUMBER OF TIME SNAPSHOTS FOR PLOTTING TIME : C : SERIES OF PROFILE DATA : C : NR = ALLOCATED " " OF FLAG RECORDS : C : NMAXOB = ALLOCATED MAXIMUM NUMBER OF OBSERVATIONS : C : NALTIM = ALLOCATED NUMBER OF TIME SNAPSHOTS FOR PROFILE PLOTS : C : LUNSO = WRITE OUTPUT TO SCREEN : C : LUNSI = READ INPUT FROM SCREEN : C : LUNI = READ INPUT (FLAGS) FROM CONTROL FILE : C : LUNFO = WRITE OUTPUT (DATA) TO FORMATTED FILE : C : LUNR = READ INPUT (DATA) FROM BINARY FILE : C :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: PROGRAM PLTCMB PARAMETER (NUMVAR=18,nr=7,NMAXOB=200,NALTIM=25,maxrec=2000) CC integer *2 iwt,iwl,iwb,iwr,iwin,inum,ityp,idlg,nc,iitem, CC . ist,istate COMMON /FLAGS/NEXT(NALTIM),LEVSER,ITIME(NALTIM),NTIMES COMMON /LUNS/LUNR,LUNI,LUNSI,LUNSO,LUNFO COMMON /PL2/MOI,NDYI,IDOI,IHOI,IMINI,SECI,SLA,SLO COMMON /RAW/X(NMAXOB,NUMVAR,NALTIM),XT(NUMVAR),IFYN(NUMVAR,NR), . LOCYN(NUMVAR,NR),LEVMET CHARACTER DATCTL*34,DATFL*34,DATOUT*34,LABELX*65,TP*1,TD*4, . TEXTI*72 CHARACTER TITL1*20,TITL2*70,TITL3*20,TITL4*30,TITLEE*40 CHARACTER text1*25,FF*1 LOGICAL FIRST LUNSO=6 LUNSI=5 LUNI=2 LUNFO=4 LUNR=3 FIRST=.TRUE. C -------------------------------------------------------- C - ENTER THE CONTROL FILE NAME CONTAINING THE DATA SET - C - NAMES. THERE SHOULD BE .LE. NUMBER OF FILES - C -------------------------------------------------------- WRITE(LUNSO,*) ' THIS PROGRAM IS USED TO EXTRACT PBL RESULTS' WRITE(LUNSO,*) ' FROM UNFORMATTED DATA FILES.' WRITE(LUNSO,*) WRITE(LUNSO,*) ' ENTER THE CONTROL FILE NAME CONTAINING' WRITE(LUNSO,*) ' THE DATA FILE AND PLOTTING FLAGS.' WRITE(LUNSO,*) READ(LUNSI,'(A34)') DATCTL ISTEPO=1 WRITE(LUNSO,*) WRITE(LUNSO,*) ' ENTER BINARY (INPUT) FILE NAME' WRITE(LUNSO,*) ' FROM WHICH TO EXTRACT DATA.' READ(LUNSI,'(A34)') DATFL C ------------------------------------------------------- C - OPEN THE INPUT CONTROL AND BINARY FILES- C ------------------------------------------------------- OPEN(UNIT=LUNI,FILE=DATCTL,STATUS='old') C ------------------------------------------------------- C - READ MODEL OUTPUT DATA FILE NAME AND FILE FOR WHICH - C - TO SEND METACODE OUTPUT TO - C - READ THE HEADER FILE FOR INFORMATION WHICH CONTROLS - C - HOW MUCH DATA WAS OUTPUT FOR CERTAIN VARIABLES - C - (E.G. NLEV IS THE NUMBER OF LEVELS OUTPUT) - C ------------------------------------------------------- cx 200 IF (.NOT. FIRST) READ(LUNI,1020,END=800) DATFL CC 200 READ(LUNI,1020,END=800) DATFL LENGTH=LEN(DATFL) write(*,*) LENGTH DO 801 IIII=LENGTH,1,-1 IF (DATFL(LENGTH:LENGTH).EQ.' ') THEN LENGTH=LENGTH-1 ELSE GOTO 802 ENDIF 801 CONTINUE 802 DO 800 III=1,3 200 READ(LUNI,1020,END=800) DATOUT IF (III.EQ.1) THEN DATOUT=DATFL(1:LENGTH-4)//'.prof' write(*,*) DATOUT ELSEIF (III.EQ.2) THEN DATOUT=DATFL(1:LENGTH-4)//'.proftime' ELSE DATOUT=DATFL(1:LENGTH-4)//'.time' ENDIF TITL1=' ' TITL2=' ' TITL3=' ' OPEN(UNIT=LUNFO,FILE=DATOUT,STATUS='unknown', * FORM='FORMATTED') C FOR IBM, SUN, OTHER FORTRAN COMPILERS USE THE OPEN STATEMENT C BELOW OPEN(UNIT=LUNR,FILE=DATFL,STATUS='OLD',FORM='UNFORMATTED') c NEXT fortran only c OPEN(UNIT=LUNR,FILE=DATFL,STATUS='OLD',FORM='UNFORMATTED', c * block=-1) WRITE (LUNFO,1000) NTIMES=0 LEVSER=1 C ---------------------------------------------------------------- C - READ INPUT PARAMETERS FROM DUMP OF TEST DATA FILE - C - READ GRID#,# PERIODS,# SOIL LAYERS,# GEOSTROPHIC WIND LEVELS - C - # OF OBSERVED LEVELS - C ---------------------------------------------------------------- CALL HEADER(TEXTI,NLEV,MZ1,NUG,SLA,SLO,TZONE,TEND,NSOIL) KEND = IFIX((TEND+ISTEPO)/ISTEPO) !# OF OBSERVATIONS WRITE(*,900) DATFL WRITE(*,*) WRITE(*,1022) TEXTI WRITE(*,*) WRITE(*,*)' DURATION OF THE MODEL RUN = ',TEND WRITE(*,*)' INTERVAL(HOURS) BETWEEN DATA DUMPS =',ISTEPO WRITE(*,*)' NUMBER OF VERTICAL LEVELS =',NLEV WRITE(*,*)' " " VERTICAL LEVELS(INITIAL MODEL RUN) =', . MZ1 WRITE(*,*)' " " MODEL DATA DUMPS = ',KEND WRITE(*,*)' " " SOIL LAYERS =',NSOIL WRITE(*,*)' " " GEOSTROPHIC WIND LEVELS =',NUG C ----------------------------------------------------------- C - CALL ROUTINES TO 1) READ FLAGS FOR PLOTTING - C - 2) ERROR CHECK PARAMETERS FROM 1) - C - 3) READ TIME SERIES OR PROFILE DATA - C ----------------------------------------------------------- ITS=NSOIL+NLEV+6 C ITS=NSOIL+NLEV+5 CALL IFLAGS(TD,IT0,ISTEP) CALL ECHK(LUNSO,LEVSER,NLEV,TD,ntimes,naltim) IF (TD.EQ.'TIME' .or. td.eq.'time') THEN WRITE(*,*) WRITE(*,*)' READING TIME SERIES DATA' CALL RTS(ITS,NLEV,KEND,LABELX,TEXTI, * TP,TD,DATFL,ISTEPO,IT0,ISTEP, * TITL1,TITL2,TITL3,TITL4,TITLEE) ELSE WRITE(*,*) WRITE(*,*)' READING PROFILE DATA' CALL RPROF(ITS,NLEV,KEND,LABELX,TEXTI, * TP,TD,DATFL,ISTEPO,IT0,ISTEP, * TITL1,TITL2,TITL3,TITL4,TITLEE) ENDIF CLOSE(UNIT=LUNR) CLOSE(UNIT=lunfo,status='KEEP') FIRST=.FALSE. CX GO TO 200 CX 800 CONTINUE 800 CONTINUE WRITE(*,*) WRITE(*,*)' ------ ALL DATA FILES READ --------' STOP 900 FORMAT(///,1H0,' READING DATA FILE ',A34,///,1H0, . '::::::::::: DATA FILE PARAMETERS ::::::::') 1000 format('*') 1020 format(a34) 1022 FORMAT(1X,A72) END C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C + USED TO READ THE FLAGS WHICH DETERMINE WHICH VARIABLES TO PLOT + C + AS WELL AS STORE THE LOCATION AND NUMBER OF THE VARIABLES. + C + ARGUMENTS(OUTPUT) + C + TD = TYPE OF DATA 'TIME' OR 'PROF' + C + IT0 = INITIAL TIME FOR PLOTTING TIME SERIES OR TIME SERIES OF + C + PROFILE DATA + C + ISTEP = TIME STEP FROM IT0 IN WHICH TO EXTRACT THE TIME + C + SERIES DATA OR TIME SERIES OF PROFILE DATA + C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE IFLAGS(TD,IT0,ISTEP) PARAMETER (NUMVAR=18,nr=7,NMAXOB=200,NALTIM=25) PARAMETER (NVT=7) COMMON /FLAGS/NEXT(NALTIM),LEVSER,ITIME(NALTIM),NTIMES COMMON /LUNS/LUNR,LUNI,LUNSI,LUNSO,lunfo INTEGER NVARF(NVT) COMMON /RAW/X(NMAXOB,NUMVAR,NALTIM),XT(NUMVAR),IFYN(NUMVAR,NR), . LOCYN(NUMVAR,NR),LEVMET CHARACTER TD*4 DATA NVARF/12,11,11,4,5,3,3/ C -------------------------------------------------- C - READ THE FLAGS TO DETERMINE WHICH DATA TO PLOT - C - IF TYPE OF DATA='TIME SERIES(TIME)' THEN FLAGS - C - CORRESPOND TO TIME SERIES DATA, ELSE THE DATA - C - IS PROFILE DATA. - C -------------------------------------------------- NUMFL=0 READ(LUNI,5000) TD WRITE (*,*) TD IF (TD.EQ.'TIME' .or. td.eq.'time') THEN NVARF(1)=12 NVAR=NVT ELSE NVARF(1)=18 NVAR=1 ENDIF DO 1000 I=1,NVAR READ(LUNI,*) (IFYN(J,I),J=1,NVARF(I)) ! FLAGS 1000 CONTINUE C -------------------------------------------------------------- C - STORE THE LOCATION OF THE VARIABLES TO PLOT AND THE NUMBER - C - OF VARIABLES. - C -------------------------------------------------------------- DO 1060 I=1,NVAR IX=0 DO 1050 J=1,NVARF(I) IF (IFYN(J,I).EQ.1) THEN IX=IX+1 NUMFL=NUMFL+1 LOCYN(IX,I)=J ENDIF 1050 CONTINUE NEXT(I)=IX 1060 CONTINUE C ----------------------------------------------------------- C - IF PLOTTING TIME SERIES OF PROFILE DATA, PICK LEVEL - C - INITIAL TIME AND TIME STEP FOR EXTRACTING PROFILE DATA, - C - ELSE PICK THE TIMES FOR PLOTTING. IF READING TIME - C - SERIES DATA, PICK INITIAL TIME TO FIND AND TIME - C - STEP THEREAFTER TO PLOT. - C ----------------------------------------------------------- IF ((TD.EQ.'PROF' .or. td.eq.'prof') .AND. IFYN(1,1).EQ.0) THEN READ(LUNI,*) LEVSER,ITX,ISTEP IT0=ITX+1 CALL CHKSTP(ISTEP,IT0) ELSE IF (TD.EQ.'PROF' .or. td.eq.'prof') THEN NUMFL=NUMFL-1 READ(LUNI,*) NTIMES READ(LUNI,*) (ITIME(I),I=1,NTIMES) c CALL CHKTIM(NTIMES,ITIME) CALL CHKTIM ELSE READ(LUNI,*) ITX,ISTEP IT0=ITX+1 CALL CHKSTP(ISTEP,IT0) ENDIF RETURN 5000 FORMAT(A4) 6000 WRITE(*,*)' INSUFFICIENT DATA IN CONTROL FILE !' WRITE(*,*)' NOT ENOUGH VALUES GIVEN FOR PLOTTING RANGES' WRITE(*,*)' OR FOR NUMBER OF TIC MARKS.' WRITE(*,*)' ------ FORCED PROGRAM STOP --------' STOP END C +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C + THIS ROUTINE ERROR CHECKS FOR INVALID PARAMETERS THAT + C + CONTROL THE READING ROUTINES + C + ARGUMENTS (INPUT) + C + ----------------- + c + luns0 = logical unit for screen output + C + LEVSER = LEVEL CHOSEN FOR PLOTTING TIME SERIES OF + C + PROFILE DATA + C + NLEV = ACTUAL NUMBER OF VERTICAL LEVELS READ FROM THE + C + HEADER PORTION OF THE DATA FILE + c + ntimes = number of time dumps to extract for profiles + c + naltim = " " allocated time dumps to store for + c + profiles + C +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE ECHK(lunso,LEVSER,NLEV,TD,ntimes,naltim) CHARACTER *4 TD LOGICAL FLAG FLAG=.FALSE. IF ((LEVSER.GT.NLEV .OR. LEVSER.LT.1) .AND. TD.EQ.'PROF') THEN WRITE(*,*)' INVALID ENTRY !!! ' WRITE(*,*)' THERE ARE 1(SKIN) THROUGH ',NLEV,' LEVELS' WRITE(*,*)' YOU ARE TRYING TO EXTRACT LEVEL # ',LEVSER FLAG=.TRUE. ENDIF if (ntimes.gt.naltim) then WRITE(*,*)' INSUFFICIENT MEMORY !!! ' WRITE(*,*)' ALLOCATED NUMBER OF TIME DUMPS = ',NALTIM WRITE(*,*)' REQUIRED NUMBER OF TIME DUMPS = ',NTIMES WRITE(*,*)' Increase the size of NALTIM' FLAG=.TRUE. ENDIF IF (FLAG) THEN WRITE(*,*)' ------ PROGRAM TERMINATED -----' STOP ENDIF RETURN END C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C + SUBROUTINE RTS IS USED TO READ THE 'TIME SERIES' TYPE DATA + C + ARGUMENTS: + C + ITS = TOTAL NUMBER OF RECORDS PER DUMP + C + NLEV = ACTUAL NUMBER OF VERTICAL LEVELS + C + NOBS= # OBSERVATIONS TO PLOT + C + LABELX = X AXIS LABEL + C + TEXTI = TITLE OF PLOT + C + TP = 'T' IS TIME SERIES PLOT, 'P' IS PROFILE + C + TD = 'TIME' IS TIME SERIES DATA, 'PROF' IS PROFILE + C + DATFL = DATA FILE NAME TO BE WRITTEN ON PLOT + C + ISTEPO = INTERVAL (HOURS) BETWEEN MODEL FORECAST DATA DUMPS + C + IT0 = INITIAL TIME TO START PLOTTING TIME SERIES DATA + C + ISTEP = TIME STEP FROM IT0 FOR EXTRACTING TIME SERIES DATA + C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE RTS(ITS,NLEV,NOBS,LABELX,TEXTI,TP,TD,DATFL, * ISTEPO,IT0,ISTEP, * TITL1,TITL2,TITL3,TITL4,TITLEE) PARAMETER (NUMVAR=18,nr=7,NMAXOB=200,NALTIM=25) PARAMETER (NVAR=7) COMMON /FLAGS/NEXT(NALTIM),LEVSER,ITIME(NALTIM),NTIMES COMMON /LUNS/LUNR,LUNI,LUNSI,LUNSO,lunfo COMMON /PL2/MOI,NDYI,IDOI,IHOI,IMINI,SECI,SLA,SLO COMMON /RAW/X(NMAXOB,NUMVAR,NALTIM),XT(NUMVAR),IFYN(NUMVAR,NR), . LOCYN(NUMVAR,NR),LEVMET CHARACTER LABELX*65,TP*1,TD*4,DATFL*34,TEXTI*72 CHARACTER TITL1*20,TITL2*70,TITL3*20,TITL4*30,TITLEE*40 INTEGER NVARF(NVAR) DATA NVARF/12,11,11,4,5,3,3/ I1=0 C -------------------------------------------------- C - READ THE DATA AND STORE THE VARIABLES TO PLOT - C -------------------------------------------------- DO 400 I0=1,NOBS ! # OBSERVATIONS READ(LUNR,END=6000) MO,NDY,IDO,IHO,IMIN,SEC IF (I0.EQ.1) THEN MOI=MO NDYI=NDY IDOI=IDO IHOI=IHO IMINI=0 ENDIF DO 2100 J=1,NLEV READ(LUNR,END=6000) 2100 CONTINUE DO 2200 J=1,NVAR READ(LUNR,END=6000) (XT(K),K=1,NVARF(J)) IF (I0.GE.IT0 .AND. . MOD(I0-IT0,ISTEP).EQ.0) THEN I1 = (I0 - 1) / ISTEP + 1 DO 2300 L=1,NEXT(J) X(I1,L,J)=XT(LOCYN(L,J)) 2300 CONTINUE ENDIF 2200 CONTINUE 400 CONTINUE TP='T' npstrt=it0 c CALL TIMEP(NVAR,NLEV,npstrt,I1-npstrt+1,LABELX,TEXTI, c . TP,TD,DATFL,ISTEPO,IT0,ISTEP, c . TITL1,TITL2,TITL3,TITL4,TITLEE) CALL TIMEP(NVAR,NLEV,npstrt,I1,LABELX,TEXTI, . TP,TD,DATFL,ISTEPO,IT0,ISTEP, . TITL1,TITL2,TITL3,TITL4,TITLEE) RETURN 6000 WRITE(*,*)' EOF DETECTED IN SUBROUTINE RTS DURING READ.' WRITE(*,*)' I0=',I0 STOP' PROGRAM TERMINATED !!!' END C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C + SUBROUTINE RPROF IS USED TO READ "PROFILE" TYPE DATA + C + ARGUMENTS: + C + ITS = TOTAL NUMBER OF RECORDS PER DUMP + C + NLEV = ACTUAL NUMBER OF VERTICAL LEVELS + C + NOBS= # OBSERVATIONS TO PLOT + C + LABELX = X AXIS LABEL + C + TEXTI = TITLE OF PLOT + C + TP = 'T' IS TIME SERIES PLOT, 'P' IS PROFILE + C + TD = 'TIME' IS TIME SERIES DATA, 'PROF' IS PROFILE + C + DATFL = DATA FILE NAME TO BE WRITTEN ON PLOT + C + ISTEPO = INTERVAL (HOURS) BETWEEN MODEL FORECAST DATA DUMPS + C + IT0 = INITIAL TIME TO START PLOTTING TIME SERIES OF PROFILE + C + DATA + C + ISTEP = TIME STEP FROM IT0 FOR EXTRACTING TIME SERIES OF + C + PROFILE DATA + C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE RPROF(ITS,NLEV,NOBS,LABELX,TEXTI,TP,TD,DATFL, * ISTEPO,IT0,ISTEP, * TITL1,TITL2,TITL3,TITL4,TITLEE) PARAMETER (NUMVAR=18,nr=7,NMAXOB=200,NALTIM=25) PARAMETER (NVAR=1) COMMON /FLAGS/NEXT(NALTIM),LEVSER,ITIME(NALTIM),NTIMES COMMON /LUNS/LUNR,LUNI,LUNSI,LUNSO,lunfo COMMON /PL2/MOI,NDYI,IDOI,IHOI,IMINI,SECI,SLA,SLO COMMON /RAW/X(NMAXOB,NUMVAR,NALTIM),XT(NUMVAR),IFYN(NUMVAR,NR), . LOCYN(NUMVAR,NR),LEVMET CHARACTER LABELX*65,TP*1,TD*4,DATFL*34,TEXTI*72 CHARACTER TITL1*20,TITL2*70,TITL3*20,TITL4*30,TITLEE*40 LOGICAL FSKIP DATA NVARF/18/ I1=0 C -------------------------------------------------- C - READ THE DATA AND STORE THE VARIABLES TO PLOT - C - TIME SERIES OF PROFILE DATA. - C -------------------------------------------------- IF (NTIMES.EQ.0) THEN DO 400 I0=1,NOBS READ(LUNR,END=6000) MO,NDY,IDO,IHO,IMIN,SEC IF (I0.EQ.1) THEN MOI=MO NDYI=NDY IDOI=IDO IHOI=IHO IMINI=0 ENDIF DO 2100 J=NLEV,1,-1 READ(LUNR,END=6001) (XT(K),K=1,NVARF) IF (J.EQ.LEVSER .AND. I0.EQ.1) LEVMET=NINT(XT(1)) IF (J.EQ.LEVSER .AND. I0.GE.IT0 .AND. . MOD(I0-IT0,ISTEP).EQ.0) THEN I1 = (I0-1) / ISTEP + 1 DO 2300 K=1,NEXT(NVAR) X(I1,K,NVAR)=XT(LOCYN(K,NVAR)) 2300 CONTINUE ENDIF ! CORRECT LEVEL 2100 CONTINUE DO 2200 J=1,ITS-NLEV-1 READ(LUNR,END=6001) 2200 CONTINUE 400 CONTINUE TP='T' npstrt=it0 c CALL TIMEP(NVAR,NLEV,npstrt,I1-npstrt+1,LABELX,TEXTI, c . TP,TD,DATFL,ISTEPO,IT0,ISTEP, c . TITL1,TITL2,TITL3,TITL4,TITLEE) CALL TIMEP(NVAR,NLEV,npstrt,I1,LABELX,TEXTI, . TP,TD,DATFL,ISTEPO,IT0,ISTEP, . TITL1,TITL2,TITL3,TITL4,TITLEE) C ---------------------------------------- C - PROFILE OF PROFILE DATA FOR PLOTTING - C ---------------------------------------- ELSE NCT=1 DO 600 I0=1,NOBS READ(LUNR,END=6000) MO,NDY,IDO,IHO,IMIN,SEC IF (I0.EQ.1) THEN MOI=MO NDYI=NDY IDOI=IDO IHOI=IHO IMINI=0 ENDIF NCT1 = NCT FSKIP=.TRUE. DO 3005 J=NCT1,NTIMES IF (I0-1.EQ.ITIME(J)/ISTEPO) THEN DO 3100 K=NLEV,1,-1 READ(LUNR,END=6001) (XT(L),L=1,NVARF) DO 3300 L=1,NEXT(NVAR) X(K,L,NCT)=XT(LOCYN(L,NVAR)) 3300 CONTINUE 3100 CONTINUE NCT=NCT+1 FSKIP=.FALSE. ENDIF ! CORRECT TIME 3005 CONTINUE C ----------------------------------------------------------------- C - IF CORRECT TIME WAS NOT FOUND, SKIP THE BLOCK OF PROFILE DATA - C ----------------------------------------------------------------- IF (FSKIP) THEN DO 3500 J=1,NLEV READ(LUNR,END=6001) 3500 CONTINUE ENDIF C ----------------------------------------------------- C - SKIP THE TIME SERIES DATA - C ----------------------------------------------------- DO 3400 J=1,ITS-NLEV-1 READ(LUNR,END=6001) 3400 CONTINUE 600 CONTINUE TP='P' CALL PROFLE(NVAR,NLEV,LABELX,TEXTI,TP,DATFL, . TITL1,TITL2,TITL3,TITL4,TITLEE) ENDIF ! TIME SERIES VS. PROFILE RETURN 6000 WRITE(*,*)' EOF DETECTED IN SUBROUTINE RPROF.' WRITE(*,*)' READING THE DATE' WRITE(*,*)' I0=',I0 STOP' PROGRAM TERMINATED !!!' 6001 WRITE(*,*)' EOF DETECTED IN SUBROUTINE RPROF.' WRITE(LUNS0,*)' READING PROFILE OR TIME SERIES DATA' WRITE(*,*)' I0=',I0 STOP' PROGRAM TERMINATED !!!' END C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C + SUBROUTINE TIMEP IS USED TO SET UP TEXT LABELS, AND PLOTTING + C + RANGES FOR TIME SERIES DATA OR TIME SERIES OF PROFILE + C + DATA + C + ARGUMENTS: + C + NVAR = NUMBER OF RECORDS OF TIME SERIES DATA PER DUMP + C + NLEV = ACTUAL NUMBER OF VERTICAL LEVELS + C + NOBS= # OBSERVATIONS TO PLOT + C + LABELX = X AXIS LABEL + C + TITLE = TITLE OF PLOT + C + TP = 'T' IS TIME SERIES PLOT, 'P' IS PROFILE + C + TD = 'TIME' IS TIME SERIES DATA, 'PROF' IS PROFILE + C + DATFL = DATA FILE NAME TO BE WRITTEN ON PLOT + C + ISTEPO = INTERVAL (HOURS) BETWEEN MODEL FORECAST DATA DUMPS + C + IT0 = INITIAL TIME TO START PLOTTING TIME SERIES OF PROFILE + C + DATA + C + ISTEP = TIME STEP FROM IT0 FOR EXTRACTING TIME SERIES OF + C + PROFILE DATA + C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE TIMEP(NVAR,NLEV,npstrt,NOBS,LABELX,TITLE,TP,TD,DATFL, . ISTEPO,IT0,ISTEP, * TITL1,TITL2,TITL3,TITL4,TITLEE) PARAMETER (NUMVAR=18,nr=7,NMAXOB=200,NALTIM=25) COMMON /FLAGS/NEXT(NALTIM),LEVSER,ITIME(NALTIM),NTIMES COMMON /LUNS/LUNR,LUNI,LUNSI,LUNSO,lunfo COMMON /PL2/MOI,NDYI,IDOI,IHOI,IMINI,SECI,SLA,SLO COMMON /RAW/X(NMAXOB,NUMVAR,NALTIM),XT(NUMVAR),IFYN(NUMVAR,NR), . LOCYN(NUMVAR,NR),LEVMET DIMENSION XP(50) character tiltmp(50)*15,tab*1 CHARACTER TITLP(4)*60,TITLE*72 CHARACTER STRING*30,TD*4,LABELY*65,EPTITL*65 CHARACTER TITLE2(NUMVAR,NR+1)*15,LABELX*30,TP*1,TITL*10,DATFL*34 CHARACTER TITL1*20,TITL2*70,TITL3*20,TITL4*30,TITLEE*40 DATA TITLE2/'RDOWN(W/m*m)','H(W/m*m)','G(W/m*m)','LE(W/m*m)', * 'FUP(W/m*m)','SNOFLX(W/m*m)','SUM(W/m*m)', * 'FNET(W/m*m)','EP1(W/m*m)','THBAR(K)','QBAR(g/kg)', * 'ETOT(m)',6*' ', * 'TAOX(kg/m*m*s)','TAOY(kg/m*m*s)','USTAR(m/s)', * 'WSTAR(m/s)','UG(m/s)','VG(m/s)','GEOS(m/s)', * 'SINA','ANEM(m/s)','WSC(m/s)','CLC',7*' ', * 'HPBL(m)','XL(m)','RIB','RIF','RIRAD','TSFC(C)', * 'TAIR(C)','CM','CH','CG(K)','THERM(K)',7*' ', * 'PRCP(m)','DEW(m)','ACCP(mm)','ACCD(mm)',14*' ', * 'CMC(mm)','ESD(m)','PC','RC','SOLARN(W/M*M)',13*' ', * 'DSOIL 1(m)','WSOIL 1(kg/kg)','TSOIL 1(C)',15*' ', * 'DSOIL 2(m)','WSOIL 2(kg/kg)','TSOIL 2(C)',15*' ', * 'Z(m)','U(m/s)','V(m/s)','THETA(C)','T(C)','Q(g/kg)', * 'P(Pa)','SIGMA','RH','UFLUX(kg/m*m*s)', * 'VFLUX(kg/m*m*s)','THFLUX(W/m*m)','QFLUX(W/m*m)', * 'Q1(C)','Q2(C)','TD(C)','ZSP(m)','PBLK(m*m/s)'/ tab=char(9) WRITE(*,*)' BEGINNING GRAPHICS' LABELX=' ' write(labelx(1:13),'(a9,i3,a1)') 'ET(t0=hr ',it0,')' if (td.eq.'PROF' .or. td.eq.'prof') then write(labelx(14:30),'(a7,i2,a1,i4,a2)') . ',level=',levser,'(',levmet,'m)' cx write(labelx(17:27),'(a8,i2)') cx . ' ,level ',levser endif c IF(MOD(ISTEP,24).EQ.0) THEN c DELT=1. c ELSE DELT=FLOAT(ISTEP) c ENDIF do 100 i=1,nobs ip=0 DO 90 II=1,NVAR DO 80 K=1,NEXT(II) ip=ip+1 c xp(ip)=x(npstrt+i-1,k,ii) xp(ip)=x(i,k,ii) if (td.eq.'PROF' .or. td.eq.'prof') then tiltmp(ip)=title2(locyn(k,ii),nr+1) else tiltmp(ip)=title2(locyn(k,ii),ii) endif 80 CONTINUE 90 CONTINUE if (i.eq.1) then write(lunfo,1010) labelx,(tab,tiltmp(j),j=1,ip) endif write(lunfo,1020) float(i-1)*delt+it0-1., . (tab,xp(j),j=1,ip) 100 continue RETURN 1010 format(a30,50(a1,a15)) 1020 format(f8.1,50(a1,f12.4)) END C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C + SUBROUTINE PROFLE IS USED TO SET UP TEXT LABELS, AND PLOTTING + C + RANGES FOR PROFILE PLOTS + C + ARGUMENTS: + C + NVAR = NUMBER OF RECORDS OF TIME SERIES DATA PER DUMP + C + NLEV = ACTUAL NUMBER OF VERTICAL LEVELS + C + LABELX = X AXIS LABEL + C + TITLE = TITLE OF PLOT + C + TP = 'T' IS TIME SERIES PLOT, 'P' IS PROFILE + C + DATFL = DATA FILE NAME TO BE WRITTEN ON PLOT + C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE PROFLE(NVAR,NLEV,LABELX,TITLE,TP,DATFL, . TITL1,TITL2,TITL3,TITL4,TITLEE) PARAMETER (NUMVAR=18,nr=7,NMAXOB=200,NALTIM=25) COMMON /FLAGS/NEXT(NALTIM),LEVSER,ITIME(NALTIM),NTIMES COMMON /LUNS/LUNR,LUNI,LUNSI,LUNSO,lunfo COMMON /PL2/MOI,NDYI,IDOI,IHOI,IMINI,SECI,SLA,SLO COMMON /RAW/X(NMAXOB,NUMVAR,NALTIM),XT(NUMVAR),IFYN(NUMVAR,NR), . LOCYN(NUMVAR,NR),LEVMET dimension xp(numvar*naltim) character tab*1,TILTMP(25)*15 CHARACTER TITLP(4)*60,TITLE*72 CHARACTER FMTX*10,FMTY*11,STRING*30,EPTITL*65 CHARACTER TITLE1(NUMVAR)*15,LABELX*65,LABELY*65,TP*1,DATFL*34 CHARACTER TITL1*20,TITL2*70,TITL3*20,TITL4*30,TITLEE*40 DATA TITLE1/'Z(m) at hr ','U(m/s)','V(m/s)','THETA(C)','T(C)', * 'Q(g/kg)','P(Pa)','SIGMA','RH','UFLUX(kg/m*m*s)', * 'VFLUX(kg/m*m*s)','THFLUX(W/m*m)','QFLUX(W/m*m)', * 'Q1(C)','Q2(C)','TD(C)','ZSP(m)','PBLK(m*m/s)'/ cx LABELX='Height (meters)' cx WRITE(TITLP(1),1100) SLA,SLO,NLEV cx 1100 FORMAT('LAT=',F5.1,' LONG=',F6.1,' LEVELS=',I3) C --------------------------------- C - SET UP PLOTTING WINDOWS, ETC. - C --------------------------------- WRITE(*,*)' BEGINNING GRAPHICS' tab=char(9) DO 2 J=1,NTIMES TILTMP(J)(1:11)=TITLE1(1)(1:11) WRITE(TILTMP(J)(12:15),1050) ITIME(J) c WRITE(lunfo,1050) ITIME(J) 2 CONTINUE cc write(lunfo,FCMT) (title1(1)(1:11),itime(j),tab, cc . (title1(locyn(i,1)),tab,i=2,next(1)),j=1,ntimes) CM write(*,*) (title1(1)(1:11),itime(j),tab, CM . (title1(locyn(i,1)),tab,i=2,next(1)),j=1,ntimes) CM write(lunfo,1010) (title1(1)(1:11),tab, CM . (title1(locyn(i,1)),tab,i=2,next(1)),j=1,ntimes) write(lunfo,1010) (tilTMP(J),tab, . (title1(locyn(i,1)),tab,i=2,next(1)),j=1,ntimes) do 90 i=nlev,2,-1 ip=0 do 70 k=1,ntimes do 80 j=1,next(nvar) ip=ip+1 xp(ip)=x(i,j,k) 80 continue 70 continue write(lunfo,1020) (xp(kk),tab,kk=1,ip-1),xp(ip) 90 continue RETURN 1010 format(100(a15,a1)) 1020 format(450(f12.4,a1)) 1050 FORMAT(I3) END C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C + READS THE HEADER INFORMATION FROM THE BINARY DATA FILE + C + ARGUMENTS (OUTPUT) + C + TEXTI = TEXT LABEL + C + MZ = NUMBER OF LEVELS OUTPUTTED + C + MZ1 = INITIAL NUMBER OF LEVELS + C + NUG = NUMBER OF GEOSTROPHIC WINDS + C + SLA = LATITUDE + C + SLO = LONGITUDE + C + TZONE = TIME ZONE + C + TEND = DURATION OF THE MODEL RUN + C + NSOIL = NUMBER OF SOIL LAYERS + C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE HEADER(TEXTI,MZ,MZ1,NUG,SLA,SLO,TZONE,TEND,NSOIL) COMMON /LUNS/LUNR,LUNI,LUNSI,LUNSO,lunfo CHARACTER TEXTI*72 write (*,*) 'READING HEADER INFORMATION' READ(LUNR) IFHF,IFCRI,IFSNO,IFCLD READ(LUNR) NOOFGR,DELTAT,TEND,RICR,PINK,KOOL READ(LUNR) TEXTI READ(LUNR) SLA,SLO,TZONE,Z0,Z0H,ZD0,ALBEDO READ(LUNR) MO,DY,TIMEIS READ(LUNR) PSFC READ(LUNR) TREF READ(LUNR) CLC READ(LUNR) CMC READ(LUNR) PRST,PREND,PRCIP,ESD,TSNOW READ(LUNR) ISOIL,TWILT,SIGMAF,IFTC,TSO0,TSOREF,PC,RC READ(LUNR) NUG DO 788 I=1,NUG READ(LUNR) UGI,VGI,TGI 788 CONTINUE READ(LUNR) NSOIL DO 780 JS=1,NSOIL READ(LUNR) DSOIL,WSOIL,TSOIL 780 CONTINUE READ(LUNR) MZ1 READ (LUNR) MZ RETURN END C +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C + CHECKS THAT THE TIME STEP BETWEEN EXTRACTIONS IS GREATER THAN 0 + C +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE CHKSTP(ISTEP,IT0) COMMON /LUNS/LUNR,LUNI,LUNSI,LUNSO,lunfo IF (ISTEP.LE.0) THEN WRITE(*,*) WRITE(*,*)' MUST HAVE A TIME INCREMENT FOR EXTRACTION' WRITE(*,*)' GREATER THAN 0 .' WRITE(*,*) WRITE(*,*)' FIX THE CONTROL FILE AND RERUN THE PROGRAM.' WRITE(*,*)' PROGRAM STOPPED !!!' STOP ENDIF IF (IT0.LT.0) THEN WRITE(*,*) WRITE(*,*)' INITIAL TIME MUST BE GREATER THAN 0 .' WRITE(*,*) WRITE(*,*)' FIX THE CONTROL FILE AND RERUN THE PROGRAM.' WRITE(*,*)' PROGRAM STOPPED !!!!!!!!!!!!!!!!!' STOP ENDIF RETURN END C +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C + CHECKS THAT THE TIME FOR EXTRACTION IS GREATER THAN 0 + C +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ c SUBROUTINE CHKTIM(NTIMES,ITIME) SUBROUTINE CHKTIM PARAMETER (NUMVAR=18,nr=7,NMAXOB=200,NALTIM=25) COMMON /FLAGS/NEXT(NALTIM),LEVSER,ITIME(NALTIM),NTIMES COMMON /LUNS/LUNR,LUNI,LUNSI,LUNSO,lunfo c DIMENSION ITIME(1) DO 2 I=1,NTIMES IF (ITIME(I).LT.0) THEN WRITE(*,*)' INVALID CHOICE OF TIME SNAPSHOT !!!!' WRITE(*,*)' ALL TIMES ARE ELAPSED TIME STARTING AT TIME 0 ' WRITE(*,*)' AS THE INITIAL MODEL DUMP. FOR EXAMPLE, THE 6TH' WRITE(*,*)' HOUR INTO THE MODEL RUN WOULD BE TIME 6' WRITE(*,*) WRITE(*,*)' ---------> PROGRAM STOPPED <-----------' STOP ENDIF 2 CONTINUE RETURN END