C SUBROUTINE PROF(NHB,LRSTRT,ITAG,LCLAS1) C SUBROUTINE PROF(ITAG,LCLAS1) SUBROUTINE PROF_EM_NET(filename,datestr,ITAG,INCR) C C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . C SUBROUTINE: PROF PROFILE SOUNDINGS C PRGRMMR: BLACK ORG: W/NP22 DATE: 99-04-22 C C ABSTRACT: THIS ROUTINE GENERATES THE RAW PROFILE SOUNDING C OUTPUT FILES FROM THE FORECAST RESTRT FILE AND C AUXILIARY FILES C C PROGRAM HISTORY LOG: C 99-04-22 T BLACK - ORIGINATOR C 02-07-01 G MANIKIN - FIXED PROBLEM WITH DHCNVC AND DHRAIN C COMPUTATIONS - SEE COMMENTS BELOW C 03-04-01 M PYLE - BEGAN CONVERTING FOR WRF C C USAGE: CALL PROF FROM PROGRAM POST0 C C INPUT ARGUMENT LIST: C NHB - THE UNIT NUMBER FOR READING THE NHB FILE C LRSTRT - THE UNIT NUMBER FOR READING THE RESTRT FILE C ITAG - THE FORECAST HOUR WE ARE DEALING WITH C LCLAS1 - THE UNIT NUMBER FOR WRITING THE PROFILE DATA C C OUTPUT ARGUMENT LIST: C NONE C C SUBPROGRAMS CALLED: C UNIQUE: C C----------------------------------------------------------------------- c use vrbls3d c use vrbls2d c use soil c use masks use kinds, only : i_llong C include 'wrf_io_flags.h' include 'mpif.h' ! INCLUDE "parmeta" INCLUDE "parmsoil" C----------------------------------------------------------------------- P A R A M E T E R & (NSTAT=1504,LCL1ML=15,LCL1SL=52) ! & (NSTAT=1500,LCL1ML=13,LCL1SL=50) ! NWORDM=(LCL1ML+1)*LM+2*LCL1SL ! &, LRECPR=4*(8+9+LCL1ML*LM+LCL1SL)) C----------------------------------------------------------------------- C C PARMS FOR HOURLY PROFILER OUTPUT C NSTAT - MAX NUMBER OF STATIONS C NWORDM - DIMENSION OF OUTPUT ARRAY, MUST BE LARGE ENOUGH C TO HOLD ALL VARIABLES C (MAX NO MULTI-LAYER VARIABLES*LM + NO OF SINGLE LAYER VARS) C LCL1ML - NUMBER OF MULTI-LAYER VARIABLES OUTPUT FOR CLASS 1 C LCL1SL - NUMBER OF SINGLE LAYER VARIABLES OUTPUT FOR CLASS 1 C C------------------------------------------------------------------------ P A R A M E T E R & (ITB=76,JTB=134) P A R A M E T E R & (A2=17.2693882,A3=273.16,A4=35.86,PQ0=379.90516,DTR=1.74532925E-2 &, G=9.81,GI=1./G,RD=287.04,CP=1004.6,CAPA=RD/CP,RHCRIT=0.9999, & TFRZ=273.15) PARAMETER (GAMMA=6.5/1000.,ZSL=0.0,D608=0.608) PARAMETER (TAUCR=RD*GI*290.66,CONST=0.005*G/RD) C------------------------------------------------------------------------ R E A L & dz,rho,QMEAN ! R E A L ! & STNLAT(NSTAT),STNLON(NSTAT) ! R E A L ! & DETA(LM),RDETA(LM),AETA(LM),UL(2*LM) C REAL, ALLOCATABLE:: & RES(:),FIS(:),THS(:),HBOT(:) &,CFRACL(:),CFRACM(:),CFRACH(:),SNO(:) &,SOILTB(:),SFCEXC(:),SMSTAV(:),SMSTOT(:) &,Z0(:),CZEN(:),CZMEAN(:),U00(:),SR(:) &,ACPREC(:),CUPREC(:),ACSNOW(:),ACSNOM(:) &,SSROFF(:),BGROFF(:),SFCSHX(:),SFCLHX(:) &,SUBSHX(:),SNOPCX(:),ASWIN(:),ASWOUT(:) &,ASWTOA(:),ALWIN(:),ALWOUT(:),ALWTOA(:) &,TSHLTR(:),QSHLTR(:),TH2_hold(:) &,TH10(:),Q10(:),U10(:),V10(:) &,TLMIN(:),TLMAX(:) &,SMC(:,:),CMC(:),STC(:,:),SH2O(:,:) &,VEGFRC(:),POTFLX(:),PSLP(:),PDSL1(:) &,EGRID2(:),SM(:),SICE(:) &,HBM2(:),FACTR(:) &,PTBL(:,:),TTBL(:,:) &,STATPR(:),STACPR(:),STAEVP(:) &,STAPOT(:),STASHX(:),STASUB(:),STAPCX(:) &,STASWI(:),STASWO(:),STALWI(:),STALWO(:) &,STALWT(:),STASWT(:),STASNM(:),STASRF(:) &,STABRF(:),STASNO(:) &,ACPREC0(:),CUPREC0(:),SFCLHX0(:),POTFLX0(:) &,SFCSHX0(:),SUBSHX0(:),SNOPCX0(:),ASWIN0(:) &,ASWOUT0(:),ALWIN0(:),ALWOUT0(:),ALWTOA0(:) &,ASWTOA0(:),ACSNOW0(:),ACSNOM0(:),SSROFF0(:) &,BGROFF0(:) C ! R E A L ! & T(NSTAT,LM),Q(NSTAT,LM),U(NSTAT,LM),V(NSTAT,LM),Q2(NSTAT,LM) ! &,OMGALF(NSTAT,LM),CWM(NSTAT,LM),TRAIN(NSTAT,LM),TCUCN(NSTAT,LM) ! &,RSWTT(NSTAT,LM),RLWTT(NSTAT,LM),CCR(NSTAT,LM),RTOP(NSTAT,LM) ! &,HTM(NSTAT,LM),OMGA(NSTAT,LM) REAL, ALLOCATABLE:: T(:,:),Q(:,:),U(:,:),V(:,:),Q2(:,:) &, OMGALF(:,:),CWM(:,:),TRAIN(:,:),TCUCN(:,:) &,F_RAIN(:,:),F_ICE(:,:),CLDFRA(:,:) &,F_RIMEF(:,:) &, RSWTT(:,:),RLWTT(:,:),CCR(:,:),RTOP(:,:) &, HTM(:,:),OMGA(:,:),p_hold(:,:),t_hold(:,:) &, PINT(:,:),UL(:),PVAPOR(:),ZINT(:,:) C REAL, ALLOCATABLE:: DHCNVC(:,:),DHRAIN(:,:),STADHC(:),STADHR(:), & TCUCN0(:,:),TRAIN0(:,:),CPRATE(:) REAL,ALLOCATABLE:: DUM(:,:,:),DUMMY(:,:),DUMMY2(:,:), & DUM3D(:,:,:),DUM3D2(:,:,:),DUM3D3(:,:,:),GDLAT(:,:),GDLON(:,:) c &, DUM3D_U(:,:,:),DUM3D_V(:,:,:),DUM3D_SOIL(:,:,:) REAL, ALLOCATABLE:: PRODAT(:),FPACK(:) INTEGER, ALLOCATABLE:: IDUM(:,:),LMH(:,:),IW(:,:) REAL, ALLOCATABLE:: qqw(:,:),qqr(:,:),qqs(:,:),qqi(:,:), & qqg(:,:) ! INTEGER, allocatable:: IDUMMY(:,:) ! REAL, allocatable:: DUM1D(:) REAL:: STNLAT(NSTAT),STNLON(NSTAT) ! &,p_hold(NSTAT,LM),t_hold(NSTAT,LM) ! REAL:: PINT(NSTAT,LM+1),LATSTART,LONSTART REAL, ALLOCATABLE :: PMID(:,:),W(:,:), WH(:,:), & pint_part(:),PDS(:) real, allocatable:: CROT(:),SROT(:) C------------------------------------------------------------------------ I N T E G E R & IDSTN(NSTAT),IHINDX(NSTAT),JHINDX(NSTAT) &, IVINDX(NSTAT),JVINDX(NSTAT),IDAT(3) INTEGER:: GDS(200),SYSDEPINFO C C------------------------------------------------------------------------ L O G I C A L & RUN,RESTRT,FRST C------------------------------------------------------------------------ C H A R A C T E R & RSTFIL*90,RESTHR*4,LABEL*32,CISTAT*8,CIDSTN(NSTAT)*8 &,FNAME*90,ENVAR*90,BLANK*4 CHARACTER(LEN=8), ALLOCATABLE :: CIDSTN_SAVE(:) C new stuff character(len=31) :: VarName,varin character(len=90) :: fileName character(len=90) :: fileNamehold integer :: Status, DataHandle ! integer :: Status, DataHandle, hor_size, hor_size_u, hor_size_v character(len=19):: startdate,datestr,datestrold real:: rinc(5) integer:: IDATE(8),JDATE(8) C------------------------------------------------------------------------ DATA BLANK/' '/ C------------------------------------------------------------------------ C*** C*** READ IN THE INFORMATION FILE ABOUT THE SOUNDINGS C*** write(6,*) 'filename= ', filename write(6,*) 'startedate= ', startdate len=index(filename,' ')-1 write(6,*) 'actual filename LEN= ', LEN ! datestr=startdate REWIND 19 C READ(19)NUMSTA,IDSTN,STNLAT,STNLON 1, IHINDX,JHINDX,IVINDX,JVINDX,CIDSTN write(6,*) 'STNLAT(1), STNLON(1): ', STNLAT(1), STNLON(1) write(6,*) 'IHINDX(1),JHINDX(1): ', IHINDX(1),JHINDX(1) write(6,*) 'IVINDX(1),JVINDX(1): ', IVINDX(1),JVINDX(1) WRITE(6,20)NUMSTA 20 FORMAT('INIT: NUMBER OF PROFILE STATIONS ',I5) !mp allocate(CIDSTN_SAVE(NUMSTA)) DO N=1,NUMSTA CIDSTN_SAVE(N)=CIDSTN(N) ENDDO !mp if (ITAG .eq. 0) then WRITE(6,30)(IDSTN(N),STNLAT(N)/DTR,STNLON(N)/DTR 1, IHINDX(N),JHINDX(N),IVINDX(N),JVINDX(N) 2, CIDSTN(N),N=1,NUMSTA) ! else ! WRITE(6,30)(IDSTN(N),STNLAT(N)/DTR,STNLON(N)/DTR ! 1, IHINDX(N),JHINDX(N),IVINDX(N),JVINDX(N) ! 2, CIDSTN_SAVE(N),N=1,NUMSTA,20) ! endif 30 FORMAT(2X,I6,2F8.2,4I8,4X,A8) c if (ITAG .eq. 0) then FRST=.TRUE. c else c FRST=.FALSE. c endif !-------------------------------------------------------------------- !-------------------------------------------------------------------- !-------------------------------------------------------------------- if ( frst ) then frst = .false. CALL ext_ncd_ioinit(Status) print*,'CALLed ioinit', Status c write(6,*) 'filename early in PROF= ', filename c CALL ext_ncd_open_for_read( trim(fileName), 0, 0, " ", c & DataHandle, Status) write(6,*) 'filename early in PROF= ', filename(1:len) CALL ext_ncd_open_for_read(fileName(1:len), 0, 0, " ", & DataHandle, Status) print*,'CALLed open for read', Status print*,'associated DataHandle: ', DataHandle else Status = 0 endif if ( Status /= 0 ) then print*,'error opening ',fileName(1:len), &' Status = ', Status ; stop c print*,'error opening ',fileName, ' Status = ', Status ; stop endif ! write(6,*) 'js, je, jev: ', js,je,jev C Getting start time CALL ext_ncd_get_dom_ti_char(DataHandle 1 ,'START_DATE',startdate, status ) print*,'startdate= ',startdate jdate=0 idate=0 read(startdate,15)iyear,imn,iday,ihrst IDATE(2)=imn IDATE(3)=iday IDATE(1)=iyear IDATE(5)=ihrst 15 format(i4,1x,i2,1x,i2,1x,i2) print*,'start yr mo day hr =',iyear,imn,iday,ihrst ifhr=ITAG print*,' in INITPOST ifhr fileName=',ifhr,fileName call ext_ncd_get_dom_ti_integer(DataHandle, & 'WEST-EAST_GRID_DIMENSION',itmp + ,1,ioutcount,istatus) write(6,*) 'west-east dimension: ', itmp IM=itmp-1 call ext_ncd_get_dom_ti_integer(DataHandle, & 'SOUTH-NORTH_GRID_DIMENSION',itmp + ,1,ioutcount,istatus) write(6,*) 'south-north dimension: ', itmp JM=itmp-1 call ext_ncd_get_dom_ti_integer(DataHandle, & 'BOTTOM-TOP_GRID_DIMENSION',itmp + ,1,ioutcount,istatus) write(6,*) 'bottom-top dimension: ', itmp LM=itmp-1 write(6,*) 'allocate with IM, JM, LM: ', IM, JM, LM ! The end j row is going to be jend_2u for all variables except for V. JSTA_2L=1 JEND_2U=JM JS=JSTA_2L JE=JEND_2U IF (JEND_2U.EQ.JM) THEN JEV=JEND_2U+1 ELSE JEV=JEND_2U ENDIF write(6,*) 'js, je, jev: ', js,je,jev !!!!! ALLOCATE(RES(NUMSTA),FIS(NUMSTA),THS(NUMSTA),HBOT(NUMSTA)) ALLOCATE(CFRACL(NUMSTA),CFRACM(NUMSTA),CFRACH(NUMSTA)) ALLOCATE(SNO(NUMSTA),SOILTB(NUMSTA),SFCEXC(NUMSTA)) ALLOCATE(SMSTAV(NUMSTA),SMSTOT(NUMSTA)) ALLOCATE(Z0(NUMSTA),CZEN(NUMSTA),CZMEAN(NUMSTA)) ALLOCATE(U00(NUMSTA),SR(NUMSTA),ACPREC(NUMSTA)) ALLOCATE(CUPREC(NUMSTA),ACSNOW(NUMSTA),ACSNOM(NUMSTA)) ALLOCATE(SSROFF(NUMSTA),BGROFF(NUMSTA),SFCSHX(NUMSTA)) ALLOCATE(SFCLHX(NUMSTA),SUBSHX(NUMSTA),SNOPCX(NUMSTA)) ALLOCATE(ASWIN(NUMSTA),ASWOUT(NUMSTA),ASWTOA(NUMSTA)) ALLOCATE(ALWIN(NUMSTA),ALWOUT(NUMSTA),ALWTOA(NUMSTA)) ALLOCATE(TSHLTR(NUMSTA),QSHLTR(NUMSTA),TH2_hold(NUMSTA)) ALLOCATE(TH10(NUMSTA),Q10(NUMSTA),U10(NUMSTA),V10(NUMSTA)) ALLOCATE(TLMIN(NUMSTA),TLMAX(NUMSTA),SMC(NUMSTA,NSOIL)) ALLOCATE(CMC(NUMSTA),STC(NUMSTA,NSOIL),SH2O(NUMSTA,NSOIL)) ALLOCATE(VEGFRC(NUMSTA),POTFLX(NUMSTA),PSLP(NUMSTA)) ALLOCATE(PDSL1(NUMSTA),EGRID2(NUMSTA),SM(NUMSTA),SICE(NUMSTA)) ALLOCATE(HBM2(NUMSTA),FACTR(NUMSTA),PTBL(ITB,JTB),TTBL(JTB,ITB)) ALLOCATE(STATPR(NUMSTA),STACPR(NUMSTA),STAEVP(NUMSTA)) ALLOCATE(STAPOT(NUMSTA),STASHX(NUMSTA),STASUB(NUMSTA)) ALLOCATE(STAPCX(NUMSTA),STASWI(NUMSTA),STASWO(NUMSTA)) ALLOCATE(STALWI(NUMSTA),STALWO(NUMSTA),STALWT(NUMSTA)) ALLOCATE(STASWT(NUMSTA),STASNM(NUMSTA),STASRF(NUMSTA)) ALLOCATE(STABRF(NUMSTA),STASNO(NUMSTA),ACPREC0(NUMSTA)) ALLOCATE(CUPREC0(NUMSTA),SFCLHX0(NUMSTA),POTFLX0(NUMSTA)) ALLOCATE(SFCSHX0(NUMSTA),SUBSHX0(NUMSTA),SNOPCX0(NUMSTA)) ALLOCATE(ASWIN0(NUMSTA),ASWOUT0(NUMSTA),ALWIN0(NUMSTA)) ALLOCATE(ALWOUT0(NUMSTA),ALWTOA0(NUMSTA),ASWTOA0(NUMSTA)) ALLOCATE(ACSNOW0(NUMSTA),ACSNOM0(NUMSTA),SSROFF0(NUMSTA)) ALLOCATE(BGROFF0(NUMSTA)) ALLOCATE(F_RAIN(NUMSTA,LM),F_ICE(NUMSTA,LM),CLDFRA(NUMSTA,LM)) ALLOCATE(F_RIMEF(NUMSTA,LM)) ALLOCATE(T(NUMSTA,LM)) ALLOCATE(Q(NUMSTA,LM)) ALLOCATE(U(NUMSTA,LM)) ALLOCATE(V(NUMSTA,LM)) ALLOCATE(Q2(NUMSTA,LM)) ALLOCATE(OMGALF(NUMSTA,LM)) ALLOCATE(CWM(NUMSTA,LM)) ALLOCATE(TRAIN(NUMSTA,LM)) ALLOCATE(TCUCN(NUMSTA,LM)) ALLOCATE(RSWTT(NUMSTA,LM)) ALLOCATE(RLWTT(NUMSTA,LM)) ALLOCATE(CCR(NUMSTA,LM)) ALLOCATE(RTOP(NUMSTA,LM)) ALLOCATE(HTM(NUMSTA,LM)) ALLOCATE(OMGA(NUMSTA,LM)) ALLOCATE(p_hold(NUMSTA,LM)) ALLOCATE(t_hold(NUMSTA,LM)) ALLOCATE(PINT(NUMSTA,LM+1)) ALLOCATE(PVAPOR(NUMSTA)) ALLOCATE(ZINT(NUMSTA,LM+1)) ALLOCATE(W(NUMSTA,LM+1)) ALLOCATE(WH(NUMSTA,LM)) ALLOCATE(IW(NUMSTA,LM)) ALLOCATE(STADHC(LM)) ALLOCATE(STADHR(LM)) ALLOCATE(CPRATE(LM)) ALLOCATE(DHRAIN(LM,NUMSTA)) ALLOCATE(DHCNVC(LM,NUMSTA)) ALLOCATE(TCUCN0(LM,NUMSTA)) ALLOCATE(TRAIN0(LM,NUMSTA)) ! former parameter statements NWORDM=(LCL1ML+1)*LM+2*LCL1SL LRECPR=4*(8+9+LCL1ML*LM+LCL1SL) write(6,*) 'NWORDM, LRECPR=', NWORDM,LRECPR ! former parameter statements if (allocated(FPACK)) deallocate(FPACK); allocate(FPACK(NWORDM)) if (allocated(PRODAT)) deallocate(PRODAT); & allocate(PRODAT(NWORDM)) if (ALLOCATED(DUM)) deallocate(DUM); & allocate(DUM(IM,JM,4)) if (ALLOCATED(DUMMY)) deallocate(DUMMY); & allocate(DUMMY(IM,JM)) if (ALLOCATED(DUMMY2)) deallocate(DUMMY2); & allocate(DUMMY2(IM,JM)) if (ALLOCATED(DUM3D)) deallocate(DUM3D); & allocate(DUM3D(IM+1,JM+1,LM+1)) if (ALLOCATED(DUM3D2)) deallocate(DUM3D2); & allocate(DUM3D2(IM+1,JM+1,LM+1)) if (ALLOCATED(DUM3D3)) deallocate(DUM3D3); & allocate(DUM3D3(IM+1,JM+1,LM+1)) if (ALLOCATED(GDLAT)) deallocate(GDLAT); & allocate(GDLAT(IM,JM)) if (ALLOCATED(GDLON)) deallocate(GDLON); & allocate(GDLON(IM,JM)) if (ALLOCATED(IDUM)) deallocate(IDUM); & allocate(IDUM(IM,JM)) if (ALLOCATED(LMH)) deallocate(LMH); & allocate(LMH(IM,JM)) allocate(qqw(NUMSTA,LM+1)) allocate(qqr(NUMSTA,LM+1)) allocate(qqs(NUMSTA,LM+1)) allocate(qqi(NUMSTA,LM+1)) allocate(qqg(NUMSTA,LM+1)) call ext_ncd_get_dom_ti_real(DataHandle,'DX',tmp + ,1,ioutcount,istatus) dxval=nint(tmp) write(6,*) 'dxval= ', dxval call ext_ncd_get_dom_ti_real(DataHandle,'DY',tmp + ,1,ioutcount,istatus) dyval=nint(tmp) write(6,*) 'dyval= ', dyval call ext_ncd_get_dom_ti_real(DataHandle,'CEN_LAT',tmp + ,1,ioutcount,istatus) cenlat=nint(1000.*tmp) write(6,*) 'cenlat= ', cenlat call ext_ncd_get_dom_ti_real(DataHandle,'CEN_LON',tmp + ,1,ioutcount,istatus) cenlon=nint(1000.*tmp) write(6,*) 'cenlon= ', cenlon call ext_ncd_get_dom_ti_real(DataHandle,'TRUELAT1',tmp + ,1,ioutcount,istatus) truelat1=nint(1000.*tmp) write(6,*) 'truelat1= ', truelat1 call ext_ncd_get_dom_ti_real(DataHandle,'TRUELAT2',tmp + ,1,ioutcount,istatus) truelat2=nint(1000.*tmp) write(6,*) 'truelat2= ', truelat2 call ext_ncd_get_dom_ti_integer(DataHandle,'MAP_PROJ',itmp + ,1,ioutcount,istatus) maptype=itmp write(6,*) 'maptype is ', maptype !need to get DT call ext_ncd_get_dom_ti_real(DataHandle,'DT',tmp + ,1,ioutcount,istatus) write(6,*) 'status from DT get: ', istatus write(6,*) 'returned value for DT: ', tmp DT=tmp print*,'LM, DT= ',LM, DT ! get 3-D variables print*,'im,jm,lm= ',im,jm,lm c write(6,*) 'DateStr: ', DateStr VarName='U' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM+1,JS,JE,LM) write(6,*) 'U: ', DUM3D(20,20,20) VarName='V' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D2, & IM+1,1,JM+1,LM+1,IM,JS,JEV,LM) write(6,*) 'V: ', DUM3D2(20,20,20) DO L = 1, LM DO N=1,NUMSTA U(N,L)=DUM3D(IHINDX(N),JHINDX(N),L) V(N,L)=DUM3D2(IHINDX(N),JHINDX(N),L) ENDDO ENDDO write(6,*) 'U,V defined: ' VarName='W' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM+1) write(6,*) 'W: ', DUM3D(20,20,20) DO l = 1, lm+1 DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) w ( N,L ) = dum3d ( i, j, l ) END DO END DO DO L = 1,LM DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) WH(N,L) = (W(N,L)+W(N,L+1))*0.5 END DO END DO VarName='T' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) write(6,*) 'T: ', DUM3D(20,20,20) do l = 1, lm do N = 1, NUMSTA I=IHINDX(N) J=JHINDX(N) t_hold ( N , L ) = dum3d ( i, j, l ) + 300. end do end do VarName='MU' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='MUB' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY2, & IM,1,JM,1,IM,JS,JE,1) 633 format(15(f6.0,1x)) ! write(6,*) 'past MU, MUB' if (allocated(pint_part)) deallocate(pint_part) allocate(pint_part(NUMSTA)) if (allocated(PDS)) deallocate(PDS) allocate(PDS(NUMSTA)) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) pint_part(N)=DUMMY(I,J)+DUMMY2(I,J) ENDDO ! VarName='MU0' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM0D, ! & 1,1,1,1,1,1,1,1) VarName='P' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D2, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) DO L=1,LM DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) p_hold(N,L)=DUM3D2(I,J,L) ENDDO ENDDO VarName='QVAPOR' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) DO L=1,LM DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) Q(N,L)=DUM3D(I,J,L)/(1.0+DUM3D(I,J,L)) ENDDO ENDDO VarName='QCLOUD' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) DO L = 1, LM DO N=1,NUMSTA Q2(N,L)=0. CWM(N,L)=DUM3D(IHINDX(N),JHINDX(N),L) ENDDO ENDDO VarName='TSLB' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,NSOIL) DO L = 1, NSOIL DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) ! flip soil layer again because wrf soil variable vertical indexing ! is the same with eta and vertical indexing was flipped for both ! atmospheric and soil layers within getVariable STC(N,L) = DUM3D(I,J,NSOIL-L+1) END DO END DO call getVariable(fileName,DateStr,DataHandle,'ZS',SLDPTH2, & NSOIL,1,1,1,NSOIL,1,1,1) call getVariable(fileName,DateStr,DataHandle,'DZS',SLDPTH2, & NSOIL,1,1,1,NSOIL,1,1,1) VarName='Q2' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA !!! conversion needed for QSHLTR? (spec hum, mix ratio, what??) !!! conversion needed for QSHLTR? (spec hum, mix ratio, what??) !!! conversion needed for QSHLTR? (spec hum, mix ratio, what??) QSHLTR(N)=DUMMY(IHINDX(N),JHINDX(N)) ENDDO VarName='T2' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='TH2' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA TH2_hold(N)=DUMMY(IHINDX(N),JHINDX(N)) ENDDO VarName='U10' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA U10(N)=DUMMY(IHINDX(N),JHINDX(N)) ENDDO VarName='V10' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA V10(N)=DUMMY(IHINDX(N),JHINDX(N)) ENDDO DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) TH10(N)=-9999. Q10(N)=-9999. END DO VarName='SMOIS' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,NSOIL) VarName='SH2O' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D2, & IM+1,1,JM+1,LM+1,IM,JS,JE,NSOIL) DO L = 1, NSOIL DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) ! flip soil layer again because wrf soil variable vertical indexing ! is the same with eta and vertical indexing was flipped for both ! atmospheric and soil layers within getVariable SMC(N,L) = DUM3D (I,J,NSOIL-L+1) CMC(N) = DUM3D (I,J,1) ! ?????? SH2O(N,L)= DUM3D2(I,J,NSOIL-L+1) END DO END DO VarName='SMSTAV' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SMSTAV(N)=DUMMY(I,J) ENDDO VarName='SMSTOT' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SMSTOT(N)=DUMMY(I,J) ENDDO VarName='SFROFF' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='UDROFF' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='IVGTYP' call getIVariable(fileName,DateStr,DataHandle,VarName,IDUM & ,IM,1,JM,1,IM,JS,JE,1) VarName='ISLTYP' call getIVariable(fileName,DateStr,DataHandle,VarName,IDUM & ,IM,1,JM,1,IM,JS,JE,1) VarName='VEGFRA' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) VEGFRC(N)=DUMMY(I,J) ! if (mod(N,25) .eq. 0) then ! write(6,*) 'N, VEGFRC(N): ', N, VEGFRC(N) ! endif ENDDO VarName='GRDFLX' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='ACSNOW' call getVariable(fileName,DateStr,DataHandle,VarName,DUM(:,:,1), & IM,1,JM,1,IM,JS,JE,1) VarName='ACSNOM' call getVariable(fileName,DateStr,DataHandle,VarName,DUM(:,:,2), & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) ACSNOW(N)=DUM(I,J,1) ACSNOM(N)=DUM(I,J,2) ENDDO VarName='SNOW' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SNO(N)=DUMMY(I,J) ! if (SNO(N) .gt. 0) then ! write(0,*) 'N, SNO(N): ', N, SNO(N) ! endif ENDDO VarName='SNOWH' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='CANWAT' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='SST' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='THZ0' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='QZ0' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='UZ0' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='VZ0' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='QSFC' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='AKHS' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='AKMS' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='PB' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) if (allocated(PMID)) deallocate(PMID) allocate(PMID(NUMSTA,LM)) write(6,*) 'to PMID DEFINITIONS ' DO L=1,LM DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) PMID(N,L)=p_hold(N,L)+DUM3D(I,J,L) T(N,L)=t_hold(N,L)*(PMID(N,L)*1.e-5)**CAPA OMGA(N,L)=-WH(N,L)*PMID(N,L)*G/ & (RD*T(N,L)*(1+.608*Q(N,L))) !!!!! CONSTRAIN Q TO A PARTICULAR RH VALUE, FOLLOWING CALRH OF WRFPOST QC= (PQ0/PMID(N,L)) *EXP(A2*(T(N,L)-A3)/(T(N,L)-A4)) RH=Q(N,L)/QC IF (RH .gt. RHCRIT) THEN IF (RH .gt. 1.02) THEN write(6,*) 'reducing RH from: ', RH, ' at N,L: ', N,L ENDIF Q(N,L)=0.999*RHCRIT*QC ENDIF !!!!! END RH CONSTRAIN ENDDO ENDDO VarName='MAPFAC_M' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='MAPFAC_U' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='MAPFAC_V' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='F' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='E' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='SINALPHA' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='COSALPHA' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='HGT' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA RES(N)=1.0 FIS(N)=DUMMY(IHINDX(N),JHINDX(N))*G ENDDO !HERENOW ! VarName='TSK' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, ! & IM,1,JM,1,IM,JS,JE,1) VarName='P_TOP' call getVariable(fileName,DateStr,DataHandle,VarName,PT, & 1,1,1,1,1,1,1,1) write(6,*) 'returned P_TOP into PT as : ', PT !!!! need to do the qvapor fix - integrated contribution of !!!! moisture to the surface pressure VarName='PH' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D3, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM+1) write(6,*) 'PH: ', DUM3D3(20,20,20) VarName='PHB' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D2, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM+1) write(6,*) 'PHB: ', DUM3D2(20,20,20) DO L=1,LM+1 DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) ZINT(N,L)=(DUM3D2(I,J,L)+DUM3D3(I,J,L))/G ENDDO ENDDO DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) PVAPOR(N)=0. do L=1,LM dz=ZINT(N,L+1)-ZINT(N,L) rho=PMID(N,L)/(RD*T(N,L)) if (L .le. LM-1) then QMEAN=0.5*(Q(N,L)+Q(N,L+1)) else QMEAN=Q(N,L) endif if (mod(L,5) .eq. 0 .and. mod(N,20) .eq. 0) then write(0,*) 'N, L, dz, rho, qmean, increm: ', & N, L, dz, rho, qmean, G*rho*dz*QMEAN endif pvapor(N)=pvapor(N)+G*rho*dz*QMEAN enddo if(N.eq.100) write(6,*) 'pvapor=', pvapor(N) ENDDO !!!! end vapor fix !!! what is the vertical order of fields?? !!! !!! PINT has ground at LM+1, but temp appears to have ground at L=1 !!! !!! make PINT(1)=sfc !!! !!! ????????????????????? !!! DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) PINT (N,1)=PT PINT (N,LM+1)=pint_part(N)+PT+PVAPOR(N) ! PD(I,J)=PINT (N,LM+1) - PINT(N,1) PDS(N)=pint_part(N)+PT+PVAPOR(N) TSHLTR(N)=TH2_hold(N)*(PINT(N,LM+1)/100000.)**CAPA C THS(N)=DUMMY(I,J)*(100000./PINT(N,LM+1))**CAPA C DUMMY = TSK here c HBOT(N)=-9999. c CFRACL(N)=-9999. !!! constrain surface RH QC=(PQ0/PINT(N,LM+1))*EXP(A2*(TSHLTR(N)-A3)/(TSHLTR(N)-A4)) RH=QSHLTR(N)/QC IF (RH .gt. RHCRIT) THEN write(6,*) 'reducing surface RH from: ', RH, ' at N: ', N QSHLTR(N)=0.999*RHCRIT*QC ENDIF ENDDO c write(6,*) 'before adding qqw, qqr, qqs, qqi, qqg and cwm' qqw=0. qqr=0. qqs=0. qqi=0. qqg=0. cwm=0. if(imp_physics.ne.5 .and. imp_physics.ne.0)then VarName='QCLOUD' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) ! partition cloud water and ice for WSM3 DO L=1,LM DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) if(imp_physics.eq.3)then if(t(N,L) .ge. TFRZ)then qqw ( n, l ) = dum3d ( i,j,l ) else qqi ( n, l ) = dum3d ( i, j, l ) end if end if END DO END DO end if if(imp_physics.ne.5 .and. imp_physics.ne.0)then VarName='QRAIN' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) do l = 1, lm do n = 1, NUMSTA I=IHINDX(N) J=JHINDX(N) if(imp_physics .eq. 3)then if(t(n,l) .ge. TFRZ)then qqr ( n , l ) = dum3d ( i, j, l ) else qqs ( n, l ) = dum3d ( i, j, l ) end if end if end do end do end if if(imp_physics.ne.1 .and. imp_physics.ne.3 + .and. imp_physics.ne.5 .and. imp_physics.ne.0)then VarName='QICE' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) do l = 1, lm do n = 1, NUMSTA I=IHINDX(N) J=JHINDX(N) qqi ( n, l ) = dum3d ( i, j, l ) end do end do end if if(imp_physics.ne.1 .and. imp_physics.ne.3 + .and. imp_physics.ne.5 .and. imp_physics.ne.0)then VarName='QSNOW' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) do l = 1, lm do n = 1, NUMSTA I=IHINDX(N) J=JHINDX(N) qqs ( n, l ) = dum3d ( i, j, l ) end do end do end if if(imp_physics.eq.2 .or. imp_physics.eq.6 + .or. imp_physics.eq.8)then VarName='QGRAUP' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) do l = 1, lm do n = 1, NUMSTA I=IHINDX(N) J=JHINDX(N) qqg ( n, l ) = dum3d ( i, j, l ) !CHC CONVERT MIXING RATIO TO SPECIFIC HUMIDITY end do end do end if if(imp_physics.eq.5) then VarName='CWM' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) do l = 1, lm do n = 1, NUMSTA I=IHINDX(N) J=JHINDX(N) CWM(N,L)=DUM3D(I,J,L) end do end do else do l = 1, lm do n = 1, NUMSTA IF(QQR(n,L).NE.0.0) THEN CWM(N,L)=QQR(n,L) END IF IF(QQI(n,L).NE.0.0) THEN CWM(N,L)=CWM(N,L)+QQI(n,L) END IF IF(QQW(n,L).NE.0.0) THEN CWM(N,L)=CWM(N,L)+QQW(n,L) END IF IF(QQS(n,L).NE.0.0) THEN CWM(N,L)=CWM(N,L)+QQS(n,L) END IF IF(QQG(n,L).NE.0.0) THEN CWM(N,L)=CWM(N,L)+QQG(n,L) END IF end do end do end if C** Compute PSLP using NMC reduction C DO N=1,NUMSTA PSFC = PDS(N) ZSFC = FIS(N)*GI PSLP(N) = PSFC C C COMPUTE LAYER TAU (VIRTUAL TEMP*RD/G). TVRT = T(N,1)*(1.0+D608*Q(N,1)) ! if (mod(N,50) .eq. 0) then ! write(0,*) 'N, T(N,1), Q(N,1), TVRT: ', ! & N, T(N,1), Q(N,1), TVRT ! endif TAU = TVRT*RD*GI C C COMPUTE TAU AT THE GROUND (Z=ZSFC) AND SEA LEVEL (Z=0) C ASSUMING A CONSTANT LAPSE RATE OF GAMMA=6.5DEG/KM. TVRSFC = TVRT + (ZSFC- ZSL)*GAMMA TAUSFC = TVRSFC*RD*GI TVRSL = TVRT + (ZSFC- ZSL)*GAMMA TAUSL = TVRSL*RD*GI C C IF NEED BE APPLY SHEULL CORRECTION. IF ((TAUSL.GT.TAUCR).AND.(TAUSFC.LE.TAUCR)) THEN TAUSL=TAUCR ELSEIF ((TAUSL.GT.TAUCR).AND.(TAUSFC.GT.TAUCR)) THEN TAUSL = TAUCR-CONST*(TAUSFC-TAUCR)**2 ENDIF C C COMPUTE MEAN TAU. TAUAVG = 0.5*(TAUSL+TAUSFC) C C COMPUTE SEA LEVEL PRESSURE. IF (FIS(N).GT.1.0) PSLP(N) = PSFC*EXP(ZSFC/TAUAVG) c print *,n,idstn(n),pslp(n),tvrt if (mod(N,20) .eq. 0) then write(0,*) 'N, PDS(N), PSLP(N): ', N, PDS(N), PSLP(N) endif ENDDO ! VarName='FNM' ! write(6,*) 'FNM' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! write(6,*) 'FNP' ! VarName='FNP' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! write(6,*) 'RDNW' ! VarName='RDNW' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! write(6,*) 'return getVariable' ! write(6,*) 'RDN' ! VarName='RDN' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! write(6,*) 'DNW' ! VarName='DNW' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! write(6,*) 'DN' ! VarName='DN' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! VarName='ZNU' ! write(6,*) 'ZNU' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! VarName='ZNW' ! write(6,*) 'ZNW' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM+1,1,1,1,LM+1,1,1,1) ! VarName='CFN' ! write(6,*) 'CFN' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM0D, ! & 1,1,1,1,1,1,1,1) ! VarName='CFN1' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM0D, ! & 1,1,1,1,1,1,1,1) ! VarName='EPSTS' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM0D, ! & 1,1,1,1,1,1,1,1) CC CC RAINC is "ACCUMULATED TOTAL CUMULUS PRECIPITATION" CC RAINNC is "ACCUMULATED TOTAL GRID SCALE PRECIPITATION" write(6,*) 'getting RAINC' VarName='RAINC' call getVariable(fileName,DateStr,DataHandle,VarName,DUM(:,:,1), & IM,1,JM,1,IM,JS,JE,1) write(6,*) 'getting RAINNC' VarName='RAINNC' call getVariable(fileName,DateStr,DataHandle,VarName,DUM(:,:,2), & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA CUPREC(N)=DUM(IHINDX(N),JHINDX(N),1)*.001 ACPREC(N)=( DUM(IHINDX(N),JHINDX(N),1)+ & DUM(IHINDX(N),JHINDX(N),2) )*.001 ENDDO VarName='XLAT' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) do j = 1, jm do i = 1, im GDLAT ( i, j ) = DUMMY ( i, j ) end do end do ! write(6,*) 'finishing reading XLAT' VarName='XLONG' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) do j = 1, jm do i = 1, im GDLON ( i, j ) = DUMMY ( i, j ) end do end do VarName='LU_INDEX' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='TMN' call getVariable(fileName,DateStr,DataHandle,VarName,DUM(:,:,1), & IM,1,JM,1,IM,JS,JE,1) ! XLAND 1 land 2 sea VarName='XLAND' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SM(N)=DUMMY(I,J)-1.0 SOILTB(N)=DUM(I,J,1) ! NOT 100% sure on this definition ENDDO VarName='HFX' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SFCSHX(N)=-1.0*DUMMY(I,J) ENDDO VarName='QFX' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='LH' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SFCLHX(N)=-1.0*DUMMY(I,J) ENDDO VarName='SFCEXC' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SFCEXC(N)=DUMMY(I,J) ENDDO VarName='SWDOWN' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) write(6,*) 'max SWDOWN: ', maxval(DUMMY) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) ASWIN(N)=DUMMY(I,J) ENDDO VarName='SNOWC' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) write(6,*) 'finishing reading SNOWC' VarName='GSW' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) ! write(6,*) 'finishing reading GSW' DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) ASWOUT(N)=ASWIN(N)-DUMMY(I,J) ENDDO VarName='GLW' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) ! write(6,*) 'finishing reading GLW' VarName='UDROFF' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) BGROFF(N)=DUMMY(I,J) ENDDO VarName='T2MIN' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) TLMIN(N)=DUMMY(I,J) ENDDO VarName='T2MAX' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) TLMAX(N)=DUMMY(I,J) ENDDO VarName='SFROFF' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SSROFF(N)=DUMMY(I,J) ENDDO VarName='Z0' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) Z0(N)=DUMMY(I,J) ENDDO VarName='TSK' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) EGRID2(N)=DUMMY(I,J) !skin T = THS above THS(N)=DUMMY(I,J)*(100000./PINT(N,LM+1))**CAPA ENDDO write(*,*) 'LM, P, T, U, V, Q, CWM, OMGA, at station 1' DO L = 1, LM write(*,'(i5, f10.2,3f7.2,3f10.5)') L,PMID(1,L),T(1,L), & U(1,L),V(1,L), Q(1,L), CWM(1,L), OMGA(1,L) END DO write(*,*) 'QSHLTR=',QSHLTR(1) write(*,*) 'TSHLTR=',TSHLTR(1) write(*,*) 'U10=',U10(1) write(*,*) 'V10=',V10(1) write(*,*) 'ACSNOW=',ACSNOW(1) write(*,*) 'ACSNOM=',ACSNOM(1) write(*,*) 'CMC=',CMC(1) write(*,*) 'SMSTAV=',SMSTAV(1) write(*,*) 'VEGFRC=',VEGFRC(1) write(*,*) 'CUPREC=',CUPREC(1) write(*,*) 'ACPREC=',ACPREC(1) write(*,*) 'GDLAT=', GDLAT(IHINDX(1),JHINDX(1)) write(*,*) 'GDLON=', GDLON(IHINDX(1),JHINDX(1)) write(*,*) 'SM=',SM(1) !! ICE available in wrfinput file...zero out for now ! VarName='XICE' ! VarName='XICEM' VarName='SEAICE' DUMMY=0. call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SICE(N)=DUMMY(I,J) ENDDO write(*,*) 'reading file:', trim(fileName), ' done!' ! call ext_ncd_ioclose(DataHandle) call ext_ncd_ioclose( DataHandle, Status ) write(6,*) 'maybe this is the wrong guy' !!!!!!!!!!!!!!!!! END INSERT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 C------------------------------------------------------------------------ C*** C*** READ QUANTITIES NEEDED FROM THE NHB FILE C*** DO N=1,NUMSTA ! HBM2(N)=DUM(IHINDX(N),JHINDX(N),1) HBM2(N)=1.0 ENDDO C ! ICE available in wrfinput file...zero out for now (see above read in) ! DO N=1,NUMSTA ! SICE(N)=0.0 ! ENDDO C DO L=1,LM DO N=1,NUMSTA HTM(N,L)=1.0 ENDDO ENDDO write(6,*) 'set LMH to : ', LM write(6,*) 'IM,jm: ', Im,jm do J=1,JM do I=1,IM LMH(I,J)=LM enddo enddo C C Define a GDS, then use GDSWIZ to find N.N. point GDS=-1 if(maptype .eq. 1)THEN ! Lambert conformal GDS(1)=3 GDS(2)=im GDS(3)=jm GDS(4)=int(GDLAT(1,1)*1000) GDS(5)=int(GDLON(1,1)*1000) GDS(6)=8 GDS(7)=CENLON GDS(8)=DXVAL GDS(9)=DYVAL GDS(10)=0 GDS(11)=64 GDS(12)=TRUELAT2 GDS(13)=TRUELAT1 ELSE IF(MAPTYPE .EQ. 2)THEN !Polar stereographic GDS(1)=5 GDS(2)=im GDS(3)=jm GDS(4)=int(GDLAT(1,1)*1000) GDS(5)=int(GDLON(1,1)*1000) GDS(6)=8 GDS(7)=CENLON GDS(8)=DXVAL GDS(9)=DYVAL GDS(10)=0 GDS(11)=64 ELSE IF(MAPTYPE .EQ. 3)THEN !Mercator GDS(1)=1 GDS(2)=im GDS(3)=jm GDS(4)=int(GDLAT(1,1)*1000) GDS(5)=int(GDLON(1,1)*1000) GDS(6)=8 GDS(7)=int(GDLAT(IM,JM)*1000) GDS(8)=int(GDLON(IM,JM)*1000) GDS(9)=TRUELAT1 GDS(10)=0 GDS(11)=64 GDS(12)=DXVAL GDS(13)=DYVAL c GDS(14)=255 END IF ! write(6,*) 'GDS= ', (GDS(NN),NN=1,14) write(6,*) 'GDS= ', (GDS(NN),NN=1,13) C C GET ROTATION ANGLES FOR WIND C write(6,*) 'numsta= ', numsta ALLOCATE(CROT(NUMSTA),SROT(NUMSTA)) CROT=0. SROT=0. DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) RLATX=GDLAT(I,J) RLONX=GDLON(I,J) CALL GDSWIZ(GDS,-1,1,-9999.,xout,yout, & RLONX,RLATX,NRET,1,CROT(N),SROT(N)) ENDDO NTSPH=INT(3600./DT+0.50) write(6,*) 'rot angles defined, and ntsph= ', ntsph C C------------------------------------------------------------------------ C ! DO L=1,LM ! DO N=1,NUMSTA ! TRAIN(N,L)=-9999. ! TCUCN(N,L)=-9999. ! ENDDO ! ENDDO ! DO N=1,NUMSTA ! HBOT(N)=-9999. ! CFRACL(N)=-9999. ! CFRACM(N)=-9999. ! CZEN(N)=-9999. ! ENDDO ! DO N=1,NUMSTA ! CFRACH(N)=-9999. ! SMSTOT(N)=-9999. ! CZMEAN(N)=-9999. ! U00(N)=-9999. ! SR(N)=-9999. ! ENDDO ! DO N=1,NUMSTA ! SUBSHX(N)=-9999. ! SNOPCX(N)=-9999. ! ENDDO ! DO N=1,NUMSTA ! ASWTOA(N)=-9999. ! ALWOUT(N)=-9999. ! ALWTOA(N)=-9999. ! ENDDO DO N=1,NUMSTA ! POTFLX(N)=-9999. ! TLMIN(N)=-9999. ! TLMAX(N)=-9999. ENDDO C------------------------------------------------------------------------ C*** C*** READ RADIATIVE TEMPERATURE TENDENCIES C*** ! DO L=1,LM ! DO N=1,NUMSTA ! RSWTT(N,L)=-9999. ! RLWTT(N,L)=-9999. ! ENDDO ! ENDDO C c CLOSE(LRSTRT) C------------------------------------------------------------------------ C*** C*** THE FORECAST HOUR C*** c IFHR=NTSD/NTSPH IFHR=ITAG write(6,*) 'IFHR: ', IFHR C------------------------------------------------------------------------ IF(ITAG.GT.0)THEN write(6,*) 'working on preceding file' C*** C*** GENERATE THE NAME OF THE PRECEDING RESTRT FILE C*** ITAG0=ITAG-INCR RINC(1)=0. RINC(2)=float(ITAG0) RINC(3)=0. RINC(4)=0. RINC(5)=0. write(6,*) 'RINC(2): ', rinc(2) call w3movdat(rinc,idate,jdate) write(DateStrold,301) JDATE(1),JDATE(2),JDATE(3),JDATE(5) 301 format(i4,'-',i2.2,'-',i2.2,'_',i2.2,':00:00') write(6,*) 'filename later in PROF: ', filename, '_END' len=index(filename,' ')-1 write(6,*) 'LEN= ', LEN filename=filename(1:len-19)//DateStrold filename(len-2:len-2)=':' filename(len-5:len-5)=':' write(6,*) 'old filename is ', trim(filename) write(6,*) 'date for old file is: ', datestrold !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! INSERT READ FROM ABOVE ONCE WORK OUT KINKS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CALL ext_ncd_open_for_read( trim(fileName), 0, 0, " ", & DataHandle, Status) print*,'CALLed open for read', Status print*,'associated DataHandle: ', DataHandle if ( Status /= 0 ) then print*,'error opening ',fileName, ' Status = ', Status ; stop endif C Getting start time CALL ext_ncd_get_dom_ti_char(DataHandle 1 ,'START_DATE',startdate, status ) print*,'startdate= ',startdate ! ifhr=nint(rinc(2)) ! print*,' in INITPOST ifhr fileName=',ifhr,fileName call ext_ncd_get_dom_ti_real(DataHandle,'DX',tmp + ,1,ioutcount,istatus) dxval=nint(tmp) write(6,*) 'dxval= ', dxval call ext_ncd_get_dom_ti_real(DataHandle,'DY',tmp + ,1,ioutcount,istatus) dyval=nint(tmp) write(6,*) 'dyval= ', dyval call ext_ncd_get_dom_ti_real(DataHandle,'CEN_LAT',tmp + ,1,ioutcount,istatus) cenlat=nint(1000.*tmp) write(6,*) 'cenlat= ', cenlat call ext_ncd_get_dom_ti_real(DataHandle,'CEN_LON',tmp + ,1,ioutcount,istatus) cenlon=nint(1000.*tmp) write(6,*) 'cenlon= ', cenlon call ext_ncd_get_dom_ti_real(DataHandle,'TRUELAT1',tmp + ,1,ioutcount,istatus) truelat1=nint(1000.*tmp) write(6,*) 'truelat1= ', truelat1 call ext_ncd_get_dom_ti_real(DataHandle,'TRUELAT2',tmp + ,1,ioutcount,istatus) truelat2=nint(1000.*tmp) write(6,*) 'truelat2= ', truelat2 call ext_ncd_get_dom_ti_integer(DataHandle,'MAP_PROJ',itmp + ,1,ioutcount,istatus) maptype=itmp write(6,*) 'maptype is ', maptype !need to get DT call ext_ncd_get_dom_ti_real(DataHandle,'DT',tmp + ,1,ioutcount,istatus) DT=tmp print*,'DT= ',DT ! get 3-D variables print*,'im,jm,lm= ',im,jm,lm c VarName='U' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM+1,JS,JE,LM) write(6,*) 'U: ', DUM3D(20,20,20) VarName='V' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D2, & IM+1,1,JM+1,LM+1,IM,JS,JEV,LM) write(6,*) 'V: ', DUM3D2(20,20,20) VarName='W' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM+1) VarName='PH' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D2, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM+1) VarName='PHB' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM+1) print*,'finish reading geopotential' VarName='T' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) VarName='MU' call getVariable(fileName,DateStrold,DataHandle, & VarName,DUM(:,:,1), & IM,1,JM,1,IM,JS,JE,1) VarName='MUB' call getVariable(fileName,DateStrold,DataHandle, & VarName,DUM(:,:,2), & IM,1,JM,1,IM,JS,JE,1) ! VarName='MU0' ! call getVariable(fileName,DateStrold,DataHandle,VarName,DUM0D, ! & 1,1,1,1,1,1,1,1) VarName='P' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D2, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) VarName='QVAPOR' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) VarName='QCLOUD' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) VarName='TSLB' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,NSOIL) call getVariable(fileName,DateStrold,DataHandle,'ZS',SLDPTH2, & NSOIL,1,1,1,NSOIL,1,1,1) call getVariable(fileName,DateStrold,DataHandle,'DZS',SLDPTH2, & NSOIL,1,1,1,NSOIL,1,1,1) VarName='Q2' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='T2' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='TH2' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='U10' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='V10' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='SMOIS' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,NSOIL) VarName='SH2O' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D2, & IM+1,1,JM+1,LM+1,IM,JS,JE,NSOIL) VarName='SMSTAV' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='UDROFF' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) BGROFF0(N)=DUMMY(I,J) if (N .eq. 256) then write(0,*) 'N, BGROFF0: ', N, BGROFF0(N) endif ENDDO VarName='SFROFF' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SSROFF0(N)=DUMMY(I,J) ENDDO VarName='IVGTYP' call getIVariable(fileName,DateStrold,DataHandle,VarName,IDUM & ,IM,1,JM,1,IM,JS,JE,1) VarName='ISLTYP' call getIVariable(fileName,DateStrold,DataHandle,VarName,IDUM & ,IM,1,JM,1,IM,JS,JE,1) VarName='VEGFRA' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='GRDFLX' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='ACSNOW' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA ACSNOW0(N)=DUMMY(IHINDX(N),JHINDX(N)) ENDDO VarName='ACSNOM' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA ACSNOM0(N)=DUMMY(IHINDX(N),JHINDX(N)) ENDDO VarName='SNOW' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='SNOWH' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='CANWAT' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='SST' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='THZ0' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='QZ0' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='UZ0' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='VZ0' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='QSFC' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='AKHS' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='AKMS' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='PB' call getVariable(fileName,DateStrold,DataHandle,VarName,DUM3D3, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) VarName='MAPFAC_M' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='MAPFAC_U' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='MAPFAC_V' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='F' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='E' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) ! VarName='SINALPHA' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, ! & IM,1,JM,1,IM,JS,JE,1) ! VarName='COSALPHA' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, ! & IM,1,JM,1,IM,JS,JE,1) ! VarName='HGT' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, ! & IM,1,JM,1,IM,JS,JE,1) ! VarName='TSK' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, ! & IM,1,JM,1,IM,JS,JE,1) ! VarName='P_TOP' ! call getVariable(fileName,DateStr,DataHandle,VarName,PT, ! & 1,1,1,1,1,1,1,1) ! VarName='FNM' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! VarName='FNP' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! VarName='RDNW' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! VarName='RDN' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! VarName='DNW' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! VarName='DN' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! VarName='ZNU' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM,1,1,1,LM,1,1,1) ! VarName='ZNW' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM1D, ! & LM+1,1,1,1,LM+1,1,1,1) ! VarName='CFN' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM0D, ! & 1,1,1,1,1,1,1,1) ! VarName='CFN1' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM0D, ! & 1,1,1,1,1,1,1,1) ! VarName='EPSTS' ! call getVariable(fileName,DateStr,DataHandle,VarName,DUM0D, ! & 1,1,1,1,1,1,1,1) CC CC RAINC is "ACCUMULATED TOTAL CUMULUS PRECIPITATION" CC RAINNC is "ACCUMULATED TOTAL GRID SCALE PRECIPITATION" VarName='RAINC' call getVariable(fileName,DateStrold,DataHandle, & VarName,DUM(:,:,1), & IM,1,JM,1,IM,JS,JE,1) VarName='RAINNC' call getVariable(fileName,DateStrold,DataHandle, & VarName,DUM(:,:,2), & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA CUPREC0(N)=DUM(IHINDX(N),JHINDX(N),1)*.001 ACPREC0(N)=( DUM(IHINDX(N),JHINDX(N),1)+ & DUM(IHINDX(N),JHINDX(N),2) )*.001 ENDDO VarName='GSW' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='GLW' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='XLAT' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='XLONG' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='LU_INDEX' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='TMN' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) ! XLAND 1 land 2 sea VarName='XLAND' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='HFX' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SFCSHX0(N)=DUMMY(I,J) ENDDO VarName='QFX' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) VarName='LH' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) SFCLHX0(N)=DUMMY(I,J) ENDDO VarName='SNOWC' call getVariable(fileName,DateStrold,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) write(6,*) 'done reading old file' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! END INSERT READ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C ! DO N=1,NUMSTA ! TRAIN0(N,L)=DUM(IHINDX(N),JHINDX(N),1) ! TCUCN0(N,L)=DUM(IHINDX(N),JHINDX(N),2) ! TRAIN0(N,L)=-9999. ! TCUCN0(N,L)=-9999. ! ENDDO C c ENDDO C !!! !!! THESE RUNOFF ASSIGNMENTS COULD BE *WRONG* !!!!!! !!! ! DO N=1,NUMSTA ! SSROFF0(N)=DUM(IHINDX(N),JHINDX(N),3) ! BGROFF0(N)=DUM(IHINDX(N),JHINDX(N),4) ! ENDDO C ! DO N=1,NUMSTA ! SFCSHX0(N)=-9999. ! SFCLHX0(N)=-9999. ! SUBSHX0(N)=-9999. ! SNOPCX0(N)=-9999. ! ENDDO C ! DO N=1,NUMSTA ! ASWIN0(N)=-9999. ! ASWOUT0(N)=-9999. ! ASWTOA0(N)=-9999. ! ALWIN0(N)=-9999. ! ALWOUT0(N)=-9999. ! ALWTOA0(N)=-9999. ! POTFLX0(N)=-9999. ! ENDDO C C ENDIF C c CLOSE(LRSTRT) ! write(6,*) 'down to here (a)' C C Cmp IDEALLY, WON'T NEED MANY MODS BELOW THIS POINT C C C------------------------------------------------------------------------ C*** C*** ALL THE DATA IS NOW IN. C*** CALCULATE CLOUD FRACTION AND CLOUD WATER/ICE ID NUMBER. C*** C------------------------------------------------------------------------ UTIM=1. US=1. CCLIMIT=1.E-3 CLIMIT =1.E-20 C----------------------------------------------------------------------- !$OMP parallel do DO N=1,NUMSTA IW(N,1)=-9999 CCR(N,1)=-9999. ! PDSL1(N)=PD(IHINDX(N),JHINDX(N))*RES(N) PDSL1(N)=pint_part(N)*RES(N) ENDDO ! write(6,*) 'here b' C C------------------QW, QI AND QINT-------------------------------------- C !!! !!! skip section for now !!! goto 221 DO 220 L=2,LM C !$OMP parallel do private(cwmkl,fiq,hh,iwkl,lml,pp,qc,qi,qint,qkl,qw, !$OMP* rqkl,tkl,tmt0,tmt15,u00kl) DO 210 N=1,NUMSTA IW(N,L)=-9999 CCR(N,L)=-9999. ! LML=LM-LMH(IHINDX(N),JHINDX(N)) ! write(6,*) 'LML, IHINDX,JHINDX,LMH: ', IHINDX(N), ! & JHINDX(N),LMH(IHINDX(N),JHINDX(N)) ! HH=HTM(N,L)*HBM2(N) ! TKL=T(N,L) ! QKL=Q(N,L) ! CWMKL=CWM(N,L) ! TMT0=(TKL-273.16)*HH ! TMT15=AMIN1(TMT0,-15.)*HH ! AI=0.008855 ! BI=1. C ! IF(TMT0.LT.-20.)THEN ! AI=0.007225 ! BI=0.9674 ! ENDIF C Cmp PP=PDSL1(N)*AETA(L)+PT ! PP=PMID(N,L) ! QW=HH*PQ0/PP*EXP(HH*A2*(TKL-A3)/(TKL-A4)) ! QI=QW*(BI+AI*AMIN1(TMT0,0.)) ! QINT=QW*(1.-0.00032*TMT15*(TMT15+15.)) ! IF(TMT0.LE.-40.)QINT=QI C C-------------------ICE-WATER ID NUMBER IW------------------------------ C ! no defs for U00 or UL ! ! so no U00KL,FIQ,IW,CWM ! ! write(6,*) 'here c' ! write(6,*) 'L+LML: ', L+LML ! write(6,*) 'U00(N): ', U00(N) ! write(6,*) 'UL(L+LML): ', UL(L+LML) ! U00KL=U00(N)+UL(L+LML)*(0.95-U00(N))*UTIM ! IF(TMT0.LT.-15.)THEN ! FIQ=QKL-U00KL*QI ! IF(FIQ.GT.0..OR.CWMKL.GT.CLIMIT)THEN ! IW(N,L)=1 ! ELSE ! IW(N,L)=0 ! ENDIF ! ENDIF C ! IF(TMT0.GE.0.)THEN ! IW(N,L)=0 ! ENDIF C ! IF(TMT0.LT.0..AND.TMT0.GE.-15.)THEN ! IW(N,L)=0 ! IF(IW(N,L-1).EQ.1.AND.CWMKL.GT.CLIMIT)IW(N,L)=1 ! ENDIF C ! IWKL=IW(N,L) C----------------THE SATUATION SPECIFIC HUMIDITY------------------------ ! FIW=FLOAT(IWKL) ! QC=(1.-FIW)*QINT+FIW*QI C----------------THE RELATIVE HUMIDITY---------------------------------- ! IF(QC.LE.0.)THEN ! RQKL=0. ! ELSE ! RQKL=QKL/QC ! ENDIF C----------------CLOUD COVER RATIO CCR---------------------------------- ! IF(RQKL.GE.0.9999)THEN ! CCR(N,L)=AMIN1(US,RQKL) ! ELSE ! ARG=-1000.*CWMKL/(US-RQKL) ! ARG=AMAX1(ARG,-25.) ! CCR(N,L)= RQKL*(1.-EXP(ARG)) ! ENDIF C---------------------------------------------------------------------- ! write(6,*) 'here d' 210 CONTINUE 220 CONTINUE 221 continue C---------------------------------------------------------------------- C---------------------------------------------------------------------- C*** C*** BEGIN THE PROFILE POSTING CODE. C*** C---------------------------------------------------------------------- C---------------------------------------------------------------------- C*** C*** USE ZERO IN ACCUMULATION ARRAYS AT APPROPRIATE TIMES C*** IF(ITAG .eq. 0) THEN ! write(6,*) 'here (2)' C C C what would appropriate if test be here? C C DO N=1,NUMSTA C C*** ZERO ACCUMLATION ARRAYS. C STATPR(N)=0. STACPR(N)=0. STAEVP(N)=0. STAPOT(N)=0. STASHX(N)=0. STASUB(N)=0. STAPCX(N)=0. STASWI(N)=0. STASWO(N)=0. STALWI(N)=0. STALWO(N)=0. STALWT(N)=0. STASWT(N)=0. STASNM(N)=0. STASNO(N)=0. STASRF(N)=0. STABRF(N)=0. DO L=1,LM DHCNVC(L,N)=0. DHRAIN(L,N)=0. ENDDO ENDDO C GO TO 300 ENDIF C--------------------------------------------------------------------- C*** C*** WE MUST CHECK TO SEE IF WE ARE 1 HOUR AFTER ANY OF THE C*** ACCUMULATION BUCKETS HAVE BEEN EMPTIED. IF WE ARE AT SUCH A C*** TIME THEN WE NEED TO SET TO ZERO THE VARIABLES USED TO HOLD C*** THE PRECEDING HOUR'S VALUES. C*** C--------------------------------------------------------------------- C C C At this point, accumulation buckets are a foreign concept in C the WRF model. C C c TIME=(NTSD-1)*DT c RESET0=TIME-(NTSD/NPREC)*NPREC*DT c RESET1=(NPHS-1)*DT+3600. TIME=IFCST ! write(6,*) 'here (3)' ! RESET0=25. ! designed to prevent resets. Reconsider later RESET0=1. ! designed to prevent resets. Reconsider later DO N=1,NUMSTA STATPR(N)=ACPREC0(N)*1.E3 if (ACPREC0(N) .gt. 0) then ! write(6,*) 'N,ACPREC0(N),STATPR(N): ', N, ! & ACPREC0(N),STATPR(N) endif STACPR(N)=CUPREC0(N)*1.E3 STASNM(N)=ACSNOM0(N)*1.E3 STASNO(N)=ACSNOW0(N)*1.E3 STASRF(N)=SSROFF0(N)*1.E3 STABRF(N)=BGROFF0(N)*1.E3 if (N .eq. 256) then write(0,*) 'N, STABRF(N): ', N, STABRF(N) endif ENDDO ! write(6,*) 'past set' c ENDIF C c RESET0=TIME-(NTSD/NRDSW)*NRDSW*DT c IF(MOD(NTSD,NRDSW).GE.NPHS.AND.RESET0.LE.RESET1)THEN c DO N=1,NUMSTA c STASWI(N)=0. c STASWO(N)=0. c STASWT(N)=0. c ENDDO c ELSE DO N=1,NUMSTA STASWI(N)=ASWIN0(N) STASWO(N)=ASWOUT0(N) STASWT(N)=ASWTOA0(N) ENDDO c ENDIF C c RESET0=TIME-(NTSD/NRDLW)*NRDLW*DT c IF(MOD(NTSD,NRDLW).GE.NPHS.AND.RESET0.LE.RESET1)THEN c DO N=1,NUMSTA c STALWI(N)=0. c STALWO(N)=0. c STALWT(N)=0. c ENDDO c ELSE DO N=1,NUMSTA STALWI(N)=ALWIN0(N) STALWO(N)=ALWOUT0(N) STALWT(N)=-ALWTOA0(N) ENDDO c ENDIF C c RESET0=TIME-(NTSD/NSRFC)*NSRFC*DT c IF(MOD(NTSD,NSRFC).GE.NPHS.AND.RESET0.LE.RESET1)THEN c DO N=1,NUMSTA c STAEVP(N)=0. c STAPOT(N)=0. c STASHX(N)=0. c STASUB(N)=0. c STAPCX(N)=0. c ENDDO c ELSE DO N=1,NUMSTA STAEVP(N)=SFCLHX0(N) STAPOT(N)=POTFLX0(N) STASHX(N)=SFCSHX0(N) STASUB(N)=SUBSHX0(N) STAPCX(N)=SNOPCX0(N) ENDDO c ENDIF C c RESET0=TIME-(NTSD/NHEAT)*NHEAT*DT c IF(MOD(NTSD,NHEAT).GE.NCNVC.AND.RESET0.LE.RESET1)THEN c DO N=1,NUMSTA c DO L=1,LM c DHCNVC(L,N)=0. c DHRAIN(L,N)=0. c ENDDO c ENDDO c ELSE c DO N=1,NUMSTA c DO L=1,LM DHCNVC(L,N)=TCUCN0(N,L) DHRAIN(L,N)=TRAIN0(N,L) c ENDDO c ENDDO c ENDIF C------------------------------------------------------------------ 300 CONTINUE C------------------------------------------------------------------ C C*** FOR ROTATION OF WINDS FROM E-GRID TO GEODETIC ORIENTATION C*** WE NEED THE TWO QUANTITIES BELOW. C c SINPH0=SIN(TPH0D*DTR) c COSPH0=COS(TPH0D*DTR) C C*** INITIAL CALCULATIONS/PREPARATIONS. WE LOAD SEVERAL C*** ARRAYS WITH PROFILE VARIABLES. C !$OMP parallel do DO N=1,NUMSTA IF(CZMEAN(N).GT.0.)THEN FACTR(N)=CZEN(N)/CZMEAN(N) ELSE FACTR(N)=0. ENDIF ENDDO C C*** ADJUST SHORTAVE TENDENCIES TO ACCOUNT FOR CHANGE OF SOLAR POSITION C*** BETWEEN CALLS TO RADIATION C !$OMP parallel do DO L=1,LM DO N=1,NUMSTA if (RSWTT(N,L) .ne. -9999) then RSWTT(N,L)=RSWTT(N,L)*FACTR(N) endif ENDDO ENDDO C C*** COMPUTE RTOP C !$OMP parallel do DO L=1,LM DO N=1,NUMSTA ! APEL=PT+AETA(L)*PDSL1(N) APEL=PMID(N,L) RTOP(N,L)=RD*T(N,L)*(1.+0.608*Q(N,L))/APEL ENDDO ENDDO C C*** PDS IS SURFACE PRESSURE. C !$OMP parallel do DO N=1,NUMSTA I=IHINDX(N) J=JHINDX(N) ! PDS(N)=PD(I,J)+PT PDS(N)=pint_part(N)+PT ENDDO C C*** EGRID2 IS THE SURFACE TEMPERATURE. C !$OMP parallel do DO N=1,NUMSTA ! EGRID2(N)= THS(N)*(PDS(N)*1.E-5)**CAPA !read in from wrfinput IF(ACPREC(N).LT.0.)ACPREC(N)=0. IF(CUPREC(N).LT.0.)CUPREC(N)=0. ENDDO C C*** SET CYCLE, DATE, AND FORECAST TIME. C c IHR =NTSD/NTSPH+0.5 !MAYBE read(datestr,15)iyear,imn,iday,ihrst IDATE(2)=imn IDATE(3)=iday IDATE(1)=iyear IDATE(5)=ihrst IDAT(3)=IDATE(1) IDAT(1)=IDATE(2) IDAT(2)=IDATE(3) IYR =IDAT(3) IMNTH=IDAT(1) IDAY =IDAT(2) c IFCST=(NTSD-1)*DT ! IFCST=NTSPH*ITAG IFCST=3600*ITAG IHR=ITAG write(6,*) 'IFCST: ', IFCST C WRITE(6,*)' POST PROFILE FOR ', 1 IYR,IMNTH,IDAY,IHR write(6,*) 'IHRST= ', IHRST C C*** SET RTSPH,RTSCU,RTSRA TO 1. OVER THE NUMBER OF TIMES THE C*** VARIOUS PHYSICS ROUTINES HAVE BEEN C*** CALLED SINCE LAST OUTPUT OF PROFILER DATA. NECESSARY FOR C*** CORRECT AVERAGING OF VARIABLES. C write(6,*) 'APHTIM, ACUTIM, ARATIM were: ', & APHTIM, ACUTIM, ARATIM APHTIM=0. ACUTIM=0. ARATIM=0. IF(APHTIM.GT.0.)THEN RTSPH=1./APHTIM ELSE RTSPH=1. ENDIF C IF(ACUTIM.GT.0.)THEN RTSCU=1./ACUTIM ELSE RTSCU=1. ENDIF C IF(ARATIM.GT.0.)THEN RTSRA=1./ARATIM ELSE RTSRA=1. ENDIF write(6,*) 'RTSPH, RTSCU, RTSRA: ', RTSPH, RTSCU, RTSRA C C-------------------------------------------------------------------------- C-------------------------------------------------------------------------- C*** C*** OUTPUT PROFILE DATA. THE FOLLOWING LOOP IS OVER ALL PROFILE SITES. C*** C-------------------------------------------------------------------------- LCLAS1=79 write(6,*) 'open output file with RECL: ', LRECPR OPEN(UNIT=LCLAS1,ACCESS='DIRECT',RECL=LRECPR,IOSTAT=IER) C-------------------------------------------------------------------------- write(6,*) 'RECORD LENGTH = ', LRECPR DO 1000 N=1,NUMSTA C C*** ZERO OUTPUT ARRAY. C DO K=1,NWORDM PRODAT(K)=0. FPACK(K) =0. ENDDO C C*** CONSTRUCT HEADER FOR CURRENT PROFILE SITE. THE HEADER CONTAINS C*** THE FOLLOWING INFORMATION: PACKED CYCLE-DATE, FORECAST TIME, C*** INTEGER STATION ID, STATION LATITUDE, STATION LONGITUDE, STATION C*** ELEVATION, NUMBER OF VERTICAL LEVELS IN PROFILE, NUMBER OF MULTI- C*** LEVEL PARAMETERS, NUMBER OF SINGLE LEVEL PARAMETERS, TOTAL LENGTH C*** (IN WORDS) OF MULTI- AND SINGLE LEVEL DATA, PROFILE CLASS FLAG, C*** AND A DUMMY WORD FOR FUTURE USE. C IH=IHINDX(N) JH=JHINDX(N) LMHK = LMH(IH,JH) NWORD2 = 2*LMHK NWORD3 = 3*LMHK NWORD4 = 4*LMHK NWORD5 = 5*LMHK NWORD6 = 6*LMHK NWORD7 = 7*LMHK NWORD8 = 8*LMHK NWORD9 = 9*LMHK NWORD10 = 10*LMHK NWORD11 = 11*LMHK NWORD12 = 12*LMHK NWORD13 = 13*LMHK ISTAT = IDSTN(N) CISTAT = CIDSTN_SAVE(N) ! write(6,*) 'CISTAT: ', CISTAT C FPACK(1) = STNLAT(N)/DTR !mp FPACK(2) = -STNLON(N)/DTR FPACK(2) = STNLON(N)/DTR IF(FPACK(2).LT.-180.)FPACK(2)=FPACK(2)+360. FPACK(3) = FIS(N)*GI FPACK(4) = FLOAT(LMHK) ! FPACK(5) = LCL1ML -2 !?????? (in banary version -- Jun Du) FPACK(5) = LCL1ML FPACK(6) = LCL1SL FPACK(7) = 9+FPACK(5)*FPACK(4)+FPACK(6) FPACK(8) = 999. FPACK(9) = 999. C C*** WIND ROTATION SINES AND COSINES C c DLM = STNLON(N)+TLM0D*DTR c XX = COSPH0*COS(STNLAT(N))*COS(DLM) c 1 +SINPH0*SIN(STNLAT(N)) c YY = -COS(STNLAT(N))*SIN(DLM) c TLON = ATAN(YY/XX) c ALPHA = ASIN(SINPH0*SIN(TLON)/COS(STNLAT(N))) C SINALP = SIN(ALPHA) C COSALP = COS(ALPHA) SINALP = SROT(N) COSALP = CROT(N) C C------------------------------------------------------------------ C*** EXTRACT PRESSURE AND TEMPERATURE PROFILES. C*** EXTRACT/ROTATE U AND V WIND COMPONENT PROFILES. C*** EXTRACT SPECIFIC HUMIDITY AND TEMPERATURE TENDENCY. C*** EXTRACT CLOUD WATER, HEATING DUE TO CONVECTION, LARGE C*** SCALE RAIN, SHORT WAVE RADIATION, LONG WAVE RADIATION, C*** AND CLOUD FRACTION. C------------------------------------------------------------------ C DO LV=1,LMHK LVL=LMHK-LV+1 C LVL=LV !???in binary version-- Jun Du ! PRODAT(LVL) = PDSL1(N)*AETA(LV)+PT PRODAT(LVL) = PMID(N,LV) if (mod(LV,15) .eq. 0 .and. mod(N,50) .eq. 0) then ! write(6,*) 'PRODAT definition, PMID: ', N,L,PMID(N,LV) endif ! if (LVL .eq. 1 .and. mod(N,25) .eq. 0) then ! write(6,*) 'N, PSFC: ', N,PRODAT(1) ! endif PRODAT(LMHK+LVL) = T(N,LV) C*** ROTATE WINDS C UT = U(N,LV) VT = V(N,LV) PRODAT(NWORD2+LVL) = UT*COSALP+VT*SINALP PRODAT(NWORD3+LVL) = VT*COSALP-UT*SINALP if (N .eq. 1) THEN c WRITE(6,*) 'orig U,V: ', UT,VT c write(6,*) 'COSALP,SINALP: ', COSALP,SINALP c WRITE(6,*) 'rotat U,V: ', PRODAT(NWORD2+LVL),PRODAT(NWORD3+LVL) c write(6,*) '-----------------' endif C PRODAT(NWORD4+LVL) = Q(N,LV) C IF(RTOP(N,LV).GT.1.E-12) THEN PRODAT(NWORD5+LVL) = OMGA(N,LV) Cmp 1 PRODAT(NWORD5+LVL) = OMGALF(N,LV)*CP/(RTOP(N,LV)*DT) ENDIF IF(IW(N,LV).GT.0.5)THEN PRODAT(NWORD6+LVL) = -CWM(N,LV) ELSE PRODAT(NWORD6+LVL) = CWM(N,LV) ENDIF ! In bianry verson -- Jun Du ! QLIQ = (1.-F_ice(N,LV))*CWM(N,LV) ! PRODAT(NWORD6+LVL) = QLIQ-PRODAT(NWORD7+LVL) C PRODAT(NWORD7+LVL) = TCUCN(N,LV) PRODAT(NWORD8+LVL) = TRAIN(N,LV) PRODAT(NWORD9+LVL) = RSWTT(N,LV) PRODAT(NWORD10+LVL)= RLWTT(N,LV) PRODAT(NWORD11+LVL)= CCR(N,LV)*100. C IF(LV.EQ.1)THEN PRODAT(NWORD12+LVL)=Q2(N,LV) ELSE PRODAT(NWORD12+LVL)=(Q2(N,LV)+Q2(N,LV-1))*0.5 ENDIF ENDDO C C*** MODIFY ACCUMLATIONS SO AS TO REPRESENT ACCUMULATED C*** CHANGE SINCE LAST PROFILE OUTPUT TIME. C CGSM MODIFIED CODE TO ACCOUNT FOR DHCNVC AND DHRAIN BEING C COMPUTED FROM TOP DOWN WHILE PRODAT IS FILLED FROM C BOTTOM UP C DO LL=1,LMHK LVL=LMHK-LL+1 STADHC(LL) = PRODAT(NWORD7+LL) - DHCNVC(LVL,N) STADHR(LL) = PRODAT(NWORD8+LL) - DHRAIN(LVL,N) C DHCNVC(LVL,N) = PRODAT(NWORD7+LL) DHRAIN(LVL,N) = PRODAT(NWORD8+LL) C Ctmp IF(MOD(NTSD,NHEAT).LT.NCNVC)THEN DHCNVC(LVL,N) = 0. DHRAIN(LVL,N) = 0. Ctmp ENDIF ENDDO C C*** EXTRACT SINGLE LEVEL DATA. EGRID2 IS SURFACE TEMPERATURE. C PRODAT(NWORD13+1) = PSLP (N) PRODAT(NWORD13+2) = PDS (N) PRODAT(NWORD13+3) = EGRID2(N) PRODAT(NWORD13+4) = TLMIN (N) PRODAT(NWORD13+5) = TLMAX (N) PRODAT(NWORD13+6) = SMSTAV(N)*100. PRODAT(NWORD13+7) = ACPREC(N)*1000. PRODAT(NWORD13+8) = CUPREC(N)*1000. PRODAT(NWORD13+27) = Z0 (N) C STAPRX=PRODAT(NWORD13+7)-STATPR(N) STACRX=PRODAT(NWORD13+8)-STACPR(N) ! if (STAPRX .gt. 0) then ! write(6,*) '1hr precip: ', N,STAPRX ! endif C C*** ROTATE WINDS C UT = U10(N) VT = V10(N) PRODAT(NWORD13+28) = UT*COSALP+VT*SINALP PRODAT(NWORD13+29) = VT*COSALP-UT*SINALP C PRODAT(NWORD13+30) = TH10 (N) PRODAT(NWORD13+31) = Q10 (N) PRODAT(NWORD13+32) = TSHLTR(N) PRODAT(NWORD13+33) = QSHLTR(N) PRODAT(NWORD13+34) = SFCEXC(N) PRODAT(NWORD13+35) = VEGFRC(N) PRODAT(NWORD13+36) = CMC (N)*1000. PRODAT(NWORD13+37) = SMC (N,1) PRODAT(NWORD13+38) = SMC (N,2) PRODAT(NWORD13+39) = SMC (N,3) PRODAT(NWORD13+40) = SMC (N,4) PRODAT(NWORD13+41) = STC (N,1) PRODAT(NWORD13+42) = STC (N,2) PRODAT(NWORD13+43) = STC (N,3) PRODAT(NWORD13+44) = STC (N,4) PRODAT(NWORD13+45) = SM (N) + SICE(N) PRODAT(NWORD13+46) = CFRACL(N)*100. PRODAT(NWORD13+47) = CFRACM(N)*100. PRODAT(NWORD13+48) = CFRACH(N)*100. PRODAT(NWORD13+49) = SR (N)*100. PRODAT(NWORD13+50) = NINT(HBOT(N)) C PRODAT(NWORD13+9) = SFCLHX(N) PRODAT(NWORD13+10) = POTFLX(N) PRODAT(NWORD13+11) = SFCSHX(N) PRODAT(NWORD13+12) = SUBSHX(N) PRODAT(NWORD13+13) = SNOPCX(N) PRODAT(NWORD13+14) = ASWIN (N) PRODAT(NWORD13+15) = ASWOUT(N) PRODAT(NWORD13+16) = ALWIN (N) PRODAT(NWORD13+17) = ALWOUT(N) PRODAT(NWORD13+18) =-ALWTOA(N) PRODAT(NWORD13+19) = ASWTOA(N) PRODAT(NWORD13+20) = ACSNOW(N)*1000. PRODAT(NWORD13+21) = SMSTOT(N)*1000. PRODAT(NWORD13+22) = SNO (N)*1000. PRODAT(NWORD13+23) = ACSNOM(N)*1000. PRODAT(NWORD13+24) = SSROFF(N)*1000. PRODAT(NWORD13+25) = BGROFF(N)*1000. PRODAT(NWORD13+26) = SOILTB(N) C C*** ACCUMULATED CHANGE SINCE LAST PROFILE OUTPUT TIME. C PSFCEVP = PRODAT(NWORD13+9 ) - STAEVP(N) PPOTEVP = PRODAT(NWORD13+10) - STAPOT(N) PSFCSHX = PRODAT(NWORD13+11) - STASHX(N) PSFCSUB = PRODAT(NWORD13+12) - STASUB(N) PSNOPCX = PRODAT(NWORD13+13) - STAPCX(N) PRSWIN = PRODAT(NWORD13+14) - STASWI(N) PRSWOUT = PRODAT(NWORD13+15) - STASWO(N) PRLWIN = PRODAT(NWORD13+16) - STALWI(N) PRLWOUT = PRODAT(NWORD13+17) - STALWO(N) PRLWTOA = PRODAT(NWORD13+18) - STALWT(N) PRSWTOA = PRODAT(NWORD13+19) - STASWT(N) PACSNOW = PRODAT(NWORD13+20) - STASNO(N) PACSNOM = PRODAT(NWORD13+23) - STASNM(N) PSSROFF = PRODAT(NWORD13+24) - STASRF(N) PBGROFF = PRODAT(NWORD13+25) - STABRF(N) C*** C*** TRANSFER STATION PROFILE DATA TO "PACKED" OUTPUT ARRAY. C*** NN = 0 NLEN = FPACK(7) C write(6,*) 'NWORD13+41,NWORD13+32 ', NWORD13+41,NWORD13+32 C write(6,*) 'SOIL TEMP ', PRODAT(NWORD13+41) C write(6,*) 'SHELT TEMP ', PRODAT(NWORD13+32) C DO NL = 10,NLEN NN = NL-9 FPACK(NL) = PRODAT(NN) ENDDO C C*** REPLACE ACCUMULATED QUANTITIES WITH ACCUMULATION C*** SINCE LAST PROFILE OUTPUT TIME. C DO LL = 1,LMHK FPACK(9+NWORD7+LL) = STADHC(LL)*RTSCU FPACK(9+NWORD8+LL) = STADHR(LL)*RTSRA ! FPACK(9+NWORD7+LL) = -9999. ! FPACK(9+NWORD8+LL) = -9999. ENDDO C FPACK(9+NWORD13+7) = STAPRX ! write(6,*) 'precip written to FPACK element: ', 9+NWORD13+7 FPACK(9+NWORD13+8) = STACRX FPACK(9+NWORD13+9) = PSFCEVP * RTSPH FPACK(9+NWORD13+10) = PPOTEVP * RTSPH FPACK(9+NWORD13+11) = PSFCSHX * RTSPH FPACK(9+NWORD13+12) = PSFCSUB * RTSPH FPACK(9+NWORD13+13) = PSNOPCX * RTSPH FPACK(9+NWORD13+14) = PRSWIN * RTSPH FPACK(9+NWORD13+15) = PRSWOUT * RTSPH FPACK(9+NWORD13+16) = PRLWIN * RTSPH FPACK(9+NWORD13+17) = PRLWOUT * RTSPH FPACK(9+NWORD13+18) = PRLWTOA * RTSPH FPACK(9+NWORD13+19) = PRSWTOA * RTSPH FPACK(9+NWORD13+20) = PACSNOW FPACK(9+NWORD13+23) = PACSNOM FPACK(9+NWORD13+24) = PSSROFF FPACK(9+NWORD13+25) = PBGROFF C ! IF(RESTRT)THEN IF(ITAG .eq. 0)THEN DO LL = 1,LMHK FPACK(9+NWORD7+LL) = 0. FPACK(9+NWORD8+LL) = 0. ENDDO C FPACK(9+NWORD13+7) = 0. FPACK(9+NWORD13+8) = 0. FPACK(9+NWORD13+9) = 0. FPACK(9+NWORD13+10) = 0. FPACK(9+NWORD13+11) = 0. FPACK(9+NWORD13+12) = 0. FPACK(9+NWORD13+13) = 0. FPACK(9+NWORD13+14) = 0. FPACK(9+NWORD13+15) = 0. FPACK(9+NWORD13+16) = 0. FPACK(9+NWORD13+17) = 0. FPACK(9+NWORD13+18) = 0. FPACK(9+NWORD13+19) = 0. FPACK(9+NWORD13+20) = 0. FPACK(9+NWORD13+23) = 0. FPACK(9+NWORD13+24) = 0. FPACK(9+NWORD13+25) = 0. ENDIF C--------------------------------------------------------------------- C*** C*** WRITE PROFILE DATA C*** ! write(6,*) 'IFHR, NUMSTA, N, NREC: ', IFHR, NUMSTA, N, ! & IFHR*NUMSTA+N ! NREC=(IFHR/INCR)*NUMSTA+N NREC=N ! write(6,*) 'NREC, NLEN, FPACK: ', NREC, NLEN, ! & (FPACK(NNN),NNN=1,NLEN,NLEN/5) ! if (mod(NREC,20) .eq. 0) then ! write(6,*) 'NREC, IHRST, IDAT, IFCST, ISTAT, CISTAT: ', ! & NREC, IHRST, IDAT, IFCST, ISTAT, CISTAT ! endif WRITE(LCLAS1,REC=NREC)IHRST,IDAT,IFCST,ISTAT,CISTAT 1, (FPACK(NL),NL=1,NLEN) if(nrec.le.5) then write(6,*)'NREC,IHRST,IDAT,IFCST,ISTAT,CISTAT,NLEN ', 1 NREC,IHRST,IDAT,IFCST,ISTAT,CISTAT,NLEN endif C--------------------------------------------------------------------- 1000 CONTINUE CLOSE(LCLAS1) DEALLOCATE(T,Q,U,V,Q2,OMGALF,CWM,TRAIN,TCUCN) DEALLOCATE(RSWTT,RLWTT,CCR,RTOP,HTM,OMGA,p_hold) DEALLOCATE(t_hold,PINT) DEALLOCATE(DHCNVC,DHRAIN,STADHC,STADHR,TCUCN0,TRAIN0) DEALLOCATE(DUM,DUMMY,DUMMY2,DUM3D,DUM3D2,DUM3D3,GDLAT) DEALLOCATE(GDLON,PRODAT,FPACK,IDUM,LMH) DEALLOCATE( & RES,FIS,THS,HBOT &,CFRACL,CFRACM,CFRACH,SNO &,SOILTB,SFCEXC,SMSTAV,SMSTOT &,Z0,CZEN,CZMEAN,U00,SR &,ACPREC,CUPREC,ACSNOW,ACSNOM &,SSROFF,BGROFF,SFCSHX,SFCLHX &,SUBSHX,SNOPCX,ASWIN,ASWOUT &,ASWTOA,ALWIN,ALWOUT,ALWTOA &,TSHLTR,QSHLTR,TH2_hold &,TH10,Q10,U10,V10 &,TLMIN,TLMAX &,SMC,CMC,STC,SH2O &,VEGFRC,POTFLX,PSLP,PDSL1 &,EGRID2,SM,SICE &,HBM2,FACTR &,PTBL,TTBL &,STATPR,STACPR,STAEVP &,STAPOT,STASHX,STASUB,STAPCX &,STASWI,STASWO,STALWI,STALWO &,STALWT,STASWT,STASNM,STASRF &,STABRF,STASNO &,ACPREC0,CUPREC0,SFCLHX0,POTFLX0 &,SFCSHX0,SUBSHX0,SNOPCX0,ASWIN0 &,ASWOUT0,ALWIN0,ALWOUT0,ALWTOA0 &,ASWTOA0,ACSNOW0,ACSNOM0,SSROFF0 &,BGROFF0) DEALLOCATE(PVAPOR,ZINT) deallocate(qqw,qqr,qqs,qqi,qqg) C C*** END OF PROFILE SITE LOOP C C*** END PROFILE POSTING CODE. C--------------------------------------------------------------------- write(6,*) 'end of PROF_EM_NET' RETURN END