!======================================================================================= ! E grid interpolation for mass with addition of terrain adjustments. First routine ! pertains to initial conditions and the next one corresponds to boundary conditions ! This is gopal's doing !======================================================================================= SUBROUTINE interp_mass_nmm (cfld, & ! CD field cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cits, cite, ckts, ckte, cjts, cjte, & nfld, & ! ND field nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nits, nite, nkts, nkte, njts, njte, & shw, & ! stencil half width for interp imask, & ! interpolation mask xstag, ystag, & ! staggering of field ipos, jpos, & ! Position of lower left of nest in CD nri, nrj, & ! nest ratios CII, IIH, CJJ, JJH, CBWGT1, HBWGT1, & ! south-western grid locs and weights CBWGT2, HBWGT2, CBWGT3, HBWGT3, & ! note that "C"ourse grid ones are CBWGT4, HBWGT4, & ! dummys for weights CZ3d, Z3d, & ! Z3d interpolated from CZ3d CFIS,FIS, & ! CFIS dummy on fine domain CSM,SM, & ! CSM is dummy CPDTOP,PDTOP, & CPTOP,PTOP, & CPSTD,PSTD, & CKZMAX,KZMAX ) USE MODULE_MODEL_CONSTANTS USE module_timing IMPLICIT NONE LOGICAL,INTENT(IN) :: xstag, ystag INTEGER,INTENT(IN) :: ckzmax,kzmax INTEGER,INTENT(IN) :: cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cits, cite, ckts, ckte, cjts, cjte, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nits, nite, nkts, nkte, njts, njte, & shw,ipos,jpos,nri,nrj INTEGER,DIMENSION(nims:nime,njms:njme), INTENT(IN) :: IMASK ! parent domain INTEGER,DIMENSION(cims:cime,cjms:cjme), INTENT(IN) :: CII,CJJ ! dummy REAL,DIMENSION(cims:cime,cjms:cjme), INTENT(IN) :: CBWGT1,CBWGT2,CBWGT3 REAL,DIMENSION(cims:cime,cjms:cjme), INTENT(IN) :: CBWGT4,CFIS,CSM REAL,DIMENSION(cims:cime,cjms:cjme,ckms:ckme), INTENT(IN) :: CFLD REAL,DIMENSION(cims:cime,cjms:cjme,1:KZMAX), INTENT(IN) :: CZ3d REAL,DIMENSION(1:KZMAX), INTENT(IN) :: CPSTD REAL,INTENT(IN) :: CPDTOP,CPTOP ! nested domain INTEGER,DIMENSION(nims:nime,njms:njme), INTENT(IN) :: IIH,JJH REAL,DIMENSION(nims:nime,njms:njme), INTENT(IN) :: HBWGT1,HBWGT2,HBWGT3 REAL,DIMENSION(nims:nime,njms:njme), INTENT(IN) :: HBWGT4 REAL,DIMENSION(nims:nime,njms:njme), INTENT(IN) :: FIS,SM REAL,DIMENSION(nims:nime,njms:njme,nkms:nkme), INTENT(INOUT) :: NFLD REAL,DIMENSION(1:KZMAX), INTENT(IN) :: PSTD REAL,DIMENSION(nims:nime,njms:njme,1:KZMAX), INTENT(OUT) :: Z3d REAL,INTENT(IN) :: PDTOP,PTOP ! local INTEGER,PARAMETER :: JTB=134 REAL, PARAMETER :: LAPSR=6.5E-3,GI=1./G, D608=0.608 REAL, PARAMETER :: COEF3=R_D*GI*LAPSR INTEGER :: I,J,K,IDUM REAL :: dlnpdz,tvout,pmo REAL,DIMENSION(nims:nime,njms:njme) :: ZS,DUM2d REAL,DIMENSION(JTB) :: PIN,ZIN,Y2,PIO,ZOUT,DUM1,DUM2 !----------------------------------------------------------------------------------------------------- ! !*** CHECK DOMAIN BOUNDS BEFORE INTERPOLATION ! DO J=NJTS,MIN(NJTE,NJDE-1) DO I=NITS,MIN(NITE,NIDE-1) IF(IIH(i,j).LT.(CIDS-shw) .OR. IIH(i,j).GT.(CIDE+shw)) & CALL wrf_error_fatal ('mass points:check domain bounds along x' ) IF(JJH(i,j).LT.(CJDS-shw) .OR. JJH(i,j).GT.(CJDE+shw)) & CALL wrf_error_fatal ('mass points:check domain bounds along y' ) ENDDO ENDDO IF(KZMAX .GT. (JTB-10)) & CALL wrf_error_fatal ('mass points: increase JTB in interp_mass_nmm') ! WRITE(21,*)'------------- MED NEST INITIAL 1 ----------------' ! DO J=NJTS,MIN(NJTE,NJDE-1) ! DO I=NITS,MIN(NITE,NIDE-1) ! WRITE(21,*)I,J,IMASK(I,J),NFLD(I,1,J) ! ENDDO ! ENDDO ! WRITE(21,*) ! !*** DEFINE LOCAL TOPOGRAPHY ON THE BASIS OF FIS. ALSO CHECK IF SM IS LAND (SM=0) OVER TOPO !*** YOU DON'T WANT MOUNTAINS INSIDE WATER BODIES! ! DO J=NJTS,MIN(NJTE,NJDE-1) DO I=NITS,MIN(NITE,NIDE-1) ZS(I,J)=FIS(I,J)/G ENDDO ENDDO ! !*** Interpolate GPMs DERIVED FROM STANDARD ATMOSPHERIC LAPSE RATE FROM THE PARENT TO !*** THE NESTED DOMAIN ! !*** INDEX CONVENTIONS !*** HBWGT4 !*** 4 !*** !*** !*** !*** h !*** 1 2 !*** HBWGT1 HBWGT2 !*** !*** !*** 3 !*** HBWGT3 Z3d=0.0 DO K=NKTS,KZMAX ! Please note that we are still in isobaric surfaces DO J=NJTS,MIN(NJTE,NJDE-1) DO I=NITS,MIN(NITE,NIDE-1) ! IF(MOD(JJH(I,J),2) .NE. 0)THEN ! 1,3,5,7 Z3d(I,J,K) = HBWGT1(I,J)*CZ3d(IIH(I,J), JJH(I,J) ,K) & + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,JJH(I,J) ,K) & + HBWGT3(I,J)*CZ3d(IIH(I,J), JJH(I,J)-1,K) & + HBWGT4(I,J)*CZ3d(IIH(I,J), JJH(I,J)+1,K) ELSE Z3d(I,J,K) = HBWGT1(I,J)*CZ3d(IIH(I,J), JJH(I,J) ,K) & + HBWGT2(I,J)*CZ3d(IIH(I,J)+1,JJH(I,J) ,K) & + HBWGT3(I,J)*CZ3d(IIH(I,J)+1,JJH(I,J)-1,K) & + HBWGT4(I,J)*CZ3d(IIH(I,J)+1,JJH(I,J)+1,K) ENDIF ! ENDDO ENDDO ENDDO ! RECONSTRUCT PDs ON THE BASIS OF TOPOGRAPHY AND THE INTERPOLATED HEIGHTS DO J=NJTS,MIN(NJTE,NJDE-1) DO I=NITS,MIN(NITE,NIDE-1) ! IF (ZS(I,J) .LT. Z3d(I,J,1)) THEN dlnpdz = (log(PSTD(1))-log(PSTD(2)) )/(Z3d(i,j,1)-Z3d(i,j,2)) dum2d(i,j) = exp(log(PSTD(1)) + dlnpdz*(ZS(I,J) - Z3d(i,j,1))) dum2d(i,j) = dum2d(i,j) - PDTOP -PTOP ELSE ! target level bounded by input levels DO K =NKTS,KZMAX-1 ! still in the isobaric surfaces IF(ZS(I,J) .GE. Z3d(I,J,K) .AND. ZS(I,J) .LT. Z3d(I,J,K+1))THEN dlnpdz = (log(PSTD(K))-log(PSTD(K+1)) ) /(Z3d(I,J,K)-Z3d(I,J,K+1)) dum2d(i,j) = exp(log(PSTD(K)) + dlnpdz*(ZS(I,J)- Z3d(I,J,K))) dum2d(i,j) = dum2d(i,j) - PDTOP -PTOP ENDIF ENDDO ENDIF IF(ZS(I,J) .GE. Z3d(I,J,KZMAX))THEN WRITE(0,*)'I=',I,'J=',J,'K=',KZMAX,'TERRAIN HEIGHT',ZS(I,J),'Z3d',Z3d(I,J,KZMAX) CALL wrf_error_fatal3 ( "interp_fcn.b" , 176 , "MOUNTAIN TOO HIGH TO FIT THE MODEL DEPTH") ENDIF ! ENDDO ENDDO DO K=NKDS,NKDE ! NKTE is 1, nevertheless let us pretend religious DO J=NJTS,MIN(NJTE,NJDE-1) DO I=NITS,MIN(NITE,NIDE-1) IF(IMASK(I,J) .NE. 1)THEN NFLD(I,J,K)= dum2d(i,j) ! PD defined in the nested domain ENDIF ENDDO ENDDO ENDDO ! END SUBROUTINE interp_mass_nmm ! !--------------------------------------------------------------------------------------