SUBROUTINE SURFCE(APE,ZINT,CKLQ) !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBPROGRAM: SURFCE CALCULATE SURFACE CONDITIONS ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 95-03-23 ! ABSTRACT: ! THIS ROUTINE IS THE DRIVER FOR COMPUTATION OF GROUND ! CONDITIONS. FOR GCIP, ACCUMULATOR AND OTHER ! INSTANTANEOUS HOLDING ARRAYS ARE INCLUDED. ! PROGRAM HISTORY LOG: ! 95-03-23 JANJIC - ORIGINATOR ! 95-03-28 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL ! 96-03-29 BLACK - REMOVED SCRCH COMMON ! USAGE: CALL SURFCE FROM SUBROUTINE TURBL ! INPUT ARGUMENT LIST: ! APE - EXNER FUNCTION ! ZINT - INTERFACE HEIGHTS ! CKLQ - MASK VALUE ! OUTPUT ARGUMENT LIST: ! NONE ! OUTPUT FILES: ! NONE ! SUBPROGRAMS CALLED: ! SFLX ! UTILITIES: ! NONE ! LIBRARY: ! COMMON - CTLBLK ! LOOPS ! MASKS ! PHYS ! VRBLS ! PVRBLS ! SOIL ! ACMSFC ! ACMPRE ! ACMRDS ! ACMRDL ! OPTIONS ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE : IBM SP !$$$ ! SET LOCAL PARAMETERS. !----------------------------------------------------------------------- PARAMETER & (EPSWET=.001 & , PQ0=379.90516,SEAFC=.98,TRESH=.95 & , A2=17.2693882,A3=273.16,A4=35.86 & , T0=273.16,T1=274.16,CAPA=0.28589641 & , CP=1004.6,STBOL=5.67E-8,R=287.04,ROW=1.E3 & , G=9.81E0 & !dule , ELWV=2.50E6,ELIV=2.834E6,ELIW=.334E6) PARAMETER & (A23M4=A2*(A3-A4),PQ0SEA=PQ0*SEAFC,PQ0C=PQ0*TRESH & , GROW=G*ROW & !dule , RLIVWV=ELIV/ELWV,ROWLIW=ROW*ELIW,ROWLIV=ROW*ELIV) !----------------------------------------------------------------------- !*** INCLUDE GLOBAL PARAMETERS. !----------------------------------------------------------------------- INCLUDE "parmeta.f90" INCLUDE "parm.tbl.f90" INCLUDE "parmsoil.f90" INCLUDE "mpp.h" #include "sp.h" !----------------------------------------------------------------------- !*** SET LOCAL PARAMETERS DEPENDENT ON GLOBAL PARAMETERS. !----------------------------------------------------------------------- PARAMETER & (LP1=LM+1,JAM=6+2*(JM-10)) !----------------------------------------------------------------------- LOGICAL :: & RUN,FIRST,RESTRT,SIGMA !----------------------------------------------------------------------- DIMENSION & ZLM (idim1:idim2,jdim1:jdim2) & ,PS (idim1:idim2,jdim1:jdim2),APES (idim1:idim2,jdim1:jdim2) & ,ETALM (idim1:idim2,jdim1:jdim2),PLM (idim1:idim2,jdim1:jdim2) & ,APELM (idim1:idim2,jdim1:jdim2),RDSIN (idim1:idim2,jdim1:jdim2) & ,TLM (idim1:idim2,jdim1:jdim2),THLM (idim1:idim2,jdim1:jdim2) & ,QLM (idim1:idim2,jdim1:jdim2),QLMS (idim1:idim2,jdim1:jdim2) & ,DQSDT (idim1:idim2,jdim1:jdim2) & ,CKLQ (idim1:idim2,jdim1:jdim2) & ,FFS (idim1:idim2,jdim1:jdim2),QFC1 (idim1:idim2,jdim1:jdim2) & ,APE (idim1:idim2,jdim1:jdim2,LM) & ,ZINT (idim1:idim2,jdim1:jdim2,LP1) !----------------------------------------------------------------------- DIMENSION & ! Ek 18 Jan 2000 - add SH2OK array SMCK (NSOIL),STCK (NSOIL), SH2OK (NSOIL) !----------------------------------------------------------------------- ! Ek 10 Feb 2000 - add declarations ! DECLARATIONS LOGICAL :: LFIRST LOGICAL :: LFIRSTa INTEGER :: ICE INTEGER :: ISLTPK INTEGER :: IVGTPK ! INTEGER NSOIL INTEGER :: ISPTPK REAL :: ALB REAL :: ALB2D REAL :: ALBASE REAL :: ALBEDO REAL :: DQSDTK REAL :: DTK REAL :: CHK REAL :: CMCK REAL :: ELFLX REAL :: GFLX REAL :: HFLX REAL :: LWDN REAL :: MXSNAL REAL :: PLFLX REAL :: PRCP REAL :: PTU REAL :: Q1K REAL :: Q2K REAL :: Q2SAT REAL :: RNOF1K REAL :: RNOF2K REAL :: SFCPRS REAL :: SFCSPD REAL :: SFCTH2 REAL :: SFCTMP REAL :: SH2OK REAL :: SI REAL :: SLDPTH REAL :: SMCK REAL :: SMELTK REAL :: SNDENS REAL :: SNO REAL :: SNOALB REAL :: SNODPK REAL :: SNOWH REAL :: SOILQM REAL :: SOILQW REAL :: SOLDN REAL :: STCK REAL :: T1K REAL :: TBOT REAL :: VGFRCK REAL :: Z !----------------------------------------------------------------------- !*** INCLUDE COMMON BLOCKS. !*** COMMON BLOCKS SOIL, ACMPRE, ACMSFC WERE ADDED FOR GCIP. !*** COMMON BLOCK OPTIONS WAS ADDED FOR THE POST. !----------------------------------------------------------------------- INCLUDE "COMM_CTLBLK.f90" !----------------------------------------------------------------------- INCLUDE "COMM_LOOPS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_MASKS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_PHYS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_VRBLS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_PVRBLS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_SOIL.f90" !----------------------------------------------------------------------- INCLUDE "COMM_ACMPRE.f90" !----------------------------------------------------------------------- INCLUDE "COMM_ACMSFC.f90" !----------------------------------------------------------------------- INCLUDE "COMM_ACMRDS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_ACMRDL.f90" !----------------------------------------------------------------------- INCLUDE "COMM_OPTIONS.f90" !----------------------------------------------------------------------- CHARACTER & WORD*80 DATA LFIRST / .TRUE. / ! DATA LFIRST /.FALSE./ DATA LFIRSTa / .TRUE. / !*********************************************************************** ! START SURFCE HERE !*** INITIALIZE SOME WORKING ARRAYS CALL ZERO2(QLM) CALL ZERO2(QLM) CALL ZERO2(QLMS) !*** !*** SET CONSTANTS CALCULATED HERE FOR CLARITY. !*** FDTLIW=DTQ2/ROWLIW FDTLIV=DTQ2/ROWLIV FDTW=DTQ2/2.5E9 !*** !*** SET NOAH LSM CONSTANTS AND TIME INDEPENDENT VARIABLES !*** INITIALIZE NOAH LSM HISTORICAL VARIABLES !*** !----------------------------------------------------------------------- IF(NTSD < NPHS)THEN ! omp parallel do private(i,j) DO 50 J=MYJS,MYJE DO 50 I=MYIS,MYIE PS(I,J)=PD(I,J)+PT APES(I,J)=(1.E5/PS(I,J))**CAPA PCTSNO(I,J)=-999.0 ! ---------------------------------------------------------------------- ! Set default values for sea-ice or ocean states ! open ocean, SM=1 ! sea-ice, SM=0, SICE=1 ! land, SM=0, SICE=0 !*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS IF(SM(I,J) < 0.5)THEN IF(SICE(I,J) > 0.5) THEN !*** SEA-ICE CASE SMSTAV(I,J)=1.0 SMSTOT(I,J)=1.0 SSROFF(I,J)=0.0 BGROFF(I,J)=0.0 CMC(I,J)=0.0 DO NS=1,NSOIL SMC(I,J,NS)=1.0 SH2O(I,J,NS)=1.0 ENDDO ENDIF ELSE !*** Water Case SMSTAV(I,J)=1.0 SMSTOT(I,J)=1.0 SSROFF(I,J)=0.0 BGROFF(I,J)=0.0 SOILTB(I,J)=273.16 GRNFLX(I,J)=0. SUBSHX(I,J)=0.0 ACSNOW(I,J)=0.0 ACSNOM(I,J)=0.0 SNOPCX(I,J)=0.0 CMC(I,J)=0.0 SNO(I,J)=0.0 ! add SI (snow depth), ^^^SNO=snow water equivalent SI(I,J)=0.0 DO NS=1,NSOIL SMC(I,J,NS)=1.0 SH2O(I,J,NS)=1.0 STC(I,J,NS)=273.16 ENDDO ENDIF 50 END DO ENDIF !----------------------------------------------------------------------- !*** !*** SET LOWEST MODEL LAYER VARIABLES. !*** ! omp parallel do private(i,j,llmh) DO 100 J=MYJS2,MYJE2 DO 100 I=MYIS,MYIE LLMH=LMH(I,J) ETALM(I,J)=AETA(LLMH) APELM(I,J)=APE(I,J,LLMH) TLM(I,J)=T(I,J,LLMH) QLM(I,J)=Q(I,J,LLMH) ZLM(I,J)=(ZINT(I,J,LLMH)-ZINT(I,J,LLMH+1))*0.50 100 END DO ! omp parallel do private(i,j) DO 110 J=MYJS2,MYJE2 DO 110 I=MYIS,MYIE PS(I,J)=PD(I,J)+PT APES(I,J)=(1.E5/PS(I,J))**CAPA PLM(I,J)=ETALM(I,J)*PD(I,J)*RES(I,J)+PT QLMS(I,J)=((1.-SM(I,J))*PQ0+SM(I,J)*PQ0SEA) & /PLM(I,J)*EXP(A2*(TLM(I,J)-A3)/(TLM(I,J)-A4)) DQSDT(I,J)=QLMS(I,J)*A23M4/(TLM(I,J)-A4)**2 FFSK=AKHS(I,J)*PLM(I,J)*HBM2(I,J)/((QLM(I,J)*.608+1.)*TLM(I,J)*R) QFC1(I,J)=APES(I,J)*FFSK*ELWV FFS(I,J)=FFSK*CP 110 END DO !----------------------------------------------------------------------- ! omp parallel do private(i,j,factrs,factrl,tlmh) DO 120 J=MYJS2,MYJE2 DO 120 I=MYIS,MYIE !*** !*** COMPUTE RADIN AND RDSIN FOR THIS TIMESTEP !*** CZEN IS IN PHYS COMMON AND IS CURRENT FROM CALL TO RDTEMP !*** IF(CZMEAN(I,J) > 0.)THEN FACTRS=CZEN(I,J)/CZMEAN(I,J) ELSE FACTRS=0. ENDIF IF(SIGT4(I,J) > 0.)THEN TLMH=TLM(I,J) FACTRL=STBOL*TLMH*TLMH*TLMH*TLMH/SIGT4(I,J) ELSE FACTRL=0. ENDIF ! Ek 10 feb 2000 - RADIN no longer needed in SFLX (via FK) ! now use RADIN array for incoming longwave ! perhaps change the name later to e.g. RDLIN for consistency ! RADIN(I,J)=((RSWIN(I,J)-RSWOUT(I,J))*FACTRS+ ! & RLWIN(I,J)*FACTRL)*HBM2(I,J) RADIN(I,J)= RLWIN(I,J)*FACTRL*HBM2(I,J) RDSIN(I,J)= RSWIN(I,J)*FACTRS*HBM2(I,J) !*** !*** DIAGNOSTIC RADIATION ACCUMULATION !*** ASWIN (I,J)=ASWIN (I,J)+RSWIN (I,J)*HBM2(I,J)*FACTRS ASWOUT(I,J)=ASWOUT(I,J)-RSWOUT(I,J)*HBM2(I,J)*FACTRS ASWTOA(I,J)=ASWTOA(I,J)+RSWTOA(I,J)*HBM2(I,J)*FACTRS ALWIN (I,J)=ALWIN (I,J)+RLWIN (I,J)*HBM2(I,J)*FACTRL ALWOUT(I,J)=ALWOUT(I,J)-RADOT (I,J)*HBM2(I,J) ALWTOA(I,J)=ALWTOA(I,J)+RLWTOA(I,J)*HBM2(I,J) !*** !*** CHECK FOR SATURATION AT THE LOWEST MODEL LEVEL !*** IF((QLM(I,J) >= QLMS(I,J)*TRESH) .AND. (QLM(I,J) < QZ0(I,J)))THEN CKLQ(I,J)=0. ELSE CKLQ(I,J)=HBM2(I,J) ENDIF 120 END DO !----------------------------------------------------------------------- !*** !*** THS, THLM, CHEATING WET FOR PROFS !*** ! omp parallel do private(i,j) DO 130 J=MYJS2,MYJE2 DO 130 I=MYIS,MYIE THLM(I,J)=TLM(I,J)*APELM(I,J) QFC1(I,J)=QFC1(I,J)*CKLQ(I,J) 130 END DO ! Ek 10 feb 2000 - update these private statements ! add new variables: alb2d,snoalb,alb,ISPTPK ! remove old variables no longer needed: !!$omp parallel do !!$omp& private(chk,chkff,cmck,dqsdtk,dtk,elflx,fk,gflx) !!$omp& private (hflx,i,ice,isltpk,ivgtpk,j,ns,plflx,prcp) !!$omp& private (q1k,q2k,q2sat,rnof1k,rnof2k,satflg,scheck) !!$omp& private (sfcprs,sfcth2,sfctmp,smck,smeltk,snodpk) !!$omp& private (soilqm,soilqw,soldn,stck,t1k,tbot,vgfrck,z) ! Ek 10 feb 2000 - private statements ! add new variables ! remove old variables no longer needed later !!$omp& private (lwdn,sh2ok,alb2d,snoalb,alb,ISPTPK,snowh) ! Ek 18 jan 2000 - temporarily set ISPTPK=1 (2-D fixed field: x,y) ! comes from ISLSCP data set 2-d fixed field ISPTPK=1 ! ---------------------------------------------------------------------- ! Begin main 'workhorse' loop over entire model domain ! ---------------------------------------------------------------------- DO 160 J=MYJS2,MYJE2 DO 155 I=MYIS,MYIE ! ---------------------------------------------------------------------- ! Check to see that when ocean, ALBASE=ALBEDO=0.06,MXSNAL=0, ! IF (SM(I,J) .GT. 0.5) THEN ! IF ( (ALBASE(I,J) .LT. 0.059) .OR. ! . (ALBASE(I,J) .GT. 0.061) .OR. ! . (ALBEDO(I,J) .LT. 0.059) .OR. ! . (ALBEDO(I,J) .GT. 0.061) .OR. ! . (MXSNAL(I,J) .GT. 1.E-9) ) THEN ! WRITE(6,*)'ALBo:I,J,MYPE,ICE,SNODPK,ALB,ALB2D,SNOALB=', ! . I,J,MYPE,ICE,SNO(I,J),ALBASE(I,J),ALBEDO(I,J),MXSNAL(I,J) ! IERR1=1 ! ENDIF ! ENDIF ! ---------------------------------------------------------------------- IF(HBM2(I,J) < 0.5)GO TO 155 IF(SM(I,J) > 0.5)THEN THS(I,J)=SST(I,J)*APES(I,J) QS(I,J)=HBM2(I,J)*PQ0SEA/PS(I,J) & *EXP(A2*(THS(I,J)-A3*APES(I,J))/(THS(I,J)-A4*APES(I,J))) ENDIF ! ---------------------------------------------------------------------- ! Land or sea-ice ! ---------------------------------------------------------------------- !*** !*** LOADING AND UNLOADING NOAH LSM LAND SOIL VARIABLES !*** IF(SM(I,J) < 0.5)THEN ! ICE=INT(SICE(I,J)+0.3) ICE=NINT(SICE(I,J)) ! Ek 10 feb 2000 - SATFLG no longer needed in SFLX ! SATFLG=CKLQ(I,J) DTK=DTQ2 Z=ZLM(I,J) ! Ek 10 feb 2000 - FK no longer needed in SFLX ! FK=RADIN(I,J) ! Ek 18 jan 2000 - add longwave radiation calc needed for call SFLX LWDN=RADIN(I,J) SOLDN=RDSIN(I,J) SFCPRS=PLM(I,J) PRCP=PREC(I,J)*ROW/DTQ2 Q2K=QLM(I,J) Q2SAT=QLMS(I,J) ! ---------------------------------------------------------------------- ! Q2K may slightly exceed Q2SAT in some cases due to atmospheric physics ! parameterizations previously called IF (Q2K > Q2SAT) Q2K=Q2SAT DQSDTK=DQSDT(I,J) TBOT=TG(I,J) CHK=AKHS(I,J) CHKFF=FFS(I,J) IVGTPK=IVGTYP(I,J) ISLTPK=ISLTYP(I,J) ! MEB PREVENT ROUTINES IN SFLX FROM GOING OUT OF BOUNDS IF (IVGTPK == 0) IVGTPK=13 IF (ISLTPK == 0) ISLTPK=9 ! MEB PREVENT ROUTINES IN SFLX FROM GOING OUT OF BOUNDS VGFRCK=VEGFRC(I,J) Q1K=QS(I,J) SFCTMP=THLM(I,J)/APELM(I,J) SFCTH2=THLM(I,J)/APES(I,J) T1K=THS(I,J)/APES(I,J) CMCK=CMC(I,J) SNODPK=SNO(I,J) ! use 2-d prognostic field of snowdepth, SI(x,y) for ! SNOWH (local snowdepth variable) ! Ek 17 Jan 2001 SNOWH=SI(I,J) DO 140 NS=1,NSOIL SMCK(NS)=SMC(I,J,NS) ! use 3-d prognostic field of liquid soil moisture, SH2O(x,y,4) for ! SH2OK(NS) (local liquid soil moisture variable) ! Ek 11 Jan 2001 SH2OK(NS)=SH2O(I,J,NS) STCK(NS)=STC(I,J,NS) 140 END DO ! OLD CALL SFLX !----------------------------------------------------------------------- ! CALL SFLX ! & (ICE ,SATFLG,DTK ,Z, NSOIL, NROOT, SLDPTH ! &, FK ,SOLDN ,SFCPRS,PRCP ,SFCTMP,SFCTH2 ! &, Q2K ,Q2SAT ,DQSDTK,TBOT ,CHK, CHKFF ! &, IVGTPK,ISLTPK,VGFRCK ! &, PLFLX ,ELFLX ,HFLX ,GFLX ,RNOF1K,RNOF2K ! &, Q1K ,SMELTK,T1K ,CMCK ,SMCK ,STCK ,SNODPK ! &, SOILQW,SOILQM ) !----------------------------------------------------------------------- ! Ek 18 jan 2000 - temporarily set ISPTPK=1 (2-D fixed field: x,y) ! comes from ISLSCP data set 2-d fixed field ! ISPTPK=1 ! SNOALB (fixed value, max snow albedo) from MXSNAL ! via 2-d fixed field from David Robinson SNOALB=MXSNAL(I,J) ! ALB (fixed value, snow-free albedo) from ALBASE ! via 2-d fixed field from Matthews ALB=ALBASE(I,J) ! Set dynamic albedo from the dynamic albedo 2-d array, which is updated ! only for the land in SFLX, not for sea-ice, so we must 'pass through' ! ALB2D=0.60 for sea-ice. ! turn this off, and instead, do it within SFLX ! ALB2D=ALBEDO(I,J) ! ---------------------------------------------------------------------- ! Initial range check for variables/parameters for entire I,J domain for ! first timestep (when LFIRST=true). Set LFIRST=false after end of the ! 155/160 loop. IF (LFIRST) THEN ! IF ( (LFIRST) .OR. ! . (NTSD .EQ. 2) .OR. ! . (NTSD .EQ. 3) .OR. ! . (NTSD .EQ. NTSTM/2) .OR. ! . (NTSD .EQ. NTSTM) ) THEN ! ---------------------------------------------------------------------- ! land OR sea-ice checks ! land checks first IF (ICE < 0.5) THEN ! ---------------------------------------------------------------------- ! albedo checks ! ALB = ALBASE(I,J) = snow free albedo ! min = 0.11 (Matthews data base) ! max = 0.75 (Matthews data base) ! ALBEDO(I,J) = dynamic albedo (=ALBASE when SNODPK=0) ! (=ALB2D on return from SFLX) ! SNOALB = MAXSNAL(I,J) = maximum snow albedo ! min = 0.21 (Robinson data base) ! max = 0.80 (Robinson data base) ! IF ( (ALB .GT. SNOALB ) .OR. ! . (ALB .GT. ALBEDO(I,J)) .OR. ! . (ALBEDO(I,J) .GT. SNOALB ) ) THEN ! write(6,*)'ALBl1:I,J,MYPE,ICE,SNODPK,ALB,ALB2D,SNOALB=', ! . I,J,MYPE,ICE,SNODPK,ALB,ALBEDO(I,J),SNOALB ! IERR1=1 ! ENDIF ! IF ( (ALB .LT. 0.10) .OR. ! . (ALB .GT. 0.76) .OR. ! . (SNOALB .LT. 0.20) .OR. ! . (SNOALB .GT. 0.81) ) THEN ! write(6,*)'ALBl2:I,J,MYPE,ICE,SNODPK,ALB,ALB2D,SNOALB=', ! . I,J,MYPE,ICE,SNODPK,ALB,ALBEDO(I,J),SNOALB ! IERR1=1 ! ENDIF ! ---------------------------------------------------------------------- ! Veg,soil,slope type, veg fraction, No. soil layers checks ! IF ( ( (IVGTPK .LT. 1) .OR. (IVGTPK .GT. 13) ) .OR. ! . ( (ISLTPK .LT. 1) .OR. (ISLTPK .GT. 9) ) .OR. ! . (ISPTPK .NE. 1) .OR. ! . ( (VGFRCK .LT. 0.) .OR. (VGFRCK .GT. 1.) ) .OR. ! . (NSOIL .NE. 4) ) THEN ! WRITE(6,*)'LANDSFC:I,J,MYPE,IVGTPK,ISLTPK,ISPTPK,VGFRCK=', ! . I,J,MYPE,IVGTPK,ISLTPK,ISPTPK,VGFRCK ! IERR1=1 ! ENDIF ! ---------------------------------------------------------------------- DO index=1,NSOIL ! ---------------------------------------------------------------------- ! debug !x indexp = min(index+1,nsoil) !x indexm = max(index-1,1) ! ---------------------------------------------------------------------- ! Soil temp (STC) range check ! IF ((STCK(index) .LT. 223.15) .OR. ! IF ((STCK(index) .LT. 200.00) .OR. ! . (STCK(index) .GT. 323.15)) THEN ! write(6,*)'STCl:INDEX,I,J,MYPE,STC=', ! . index,I,J,MYPE,STCK(index) ! IERR1=2 ! ENDIF ! ---------------------------------------------------------------------- ! Total soil moisture (SMC) check IF ( (SMCK(index) < 0.02) .OR. & (SMCK(index) > 0.468) ) THEN write(6,*)'SMC:INDEX,I,J,MYPE,STCK,SMC,SH2O=', & index,I,J,MYPE,STCK(index),SMCK(index),SH2OK(index) ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- ! Liquid soil moisture<=total soil moisture (SH2O<=SMC) maximum check IF ( (SH2OK(index) < 0.02) .OR. & (SH2OK(index) > SMCK(index)) ) THEN write(6,*)'SH2Ol1:INDEX,I,J,MYPE,ICE,STCK,SMC,SH2O=', & index,I,J,MYPE,STCK(index),SMCK(index),SH2OK(index) ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- ! Note SH2O, SMC when STC > +0.5C !x IF (STCK(index) .GT. T0+0.5) THEN !x IF (SMCK(index)-SH2OK(index) .GT. 0.005) THEN !x write(6,*)'SH2Ol2a:INDEX,I,J,MYPE,STCK,SMC,SH2O=', !x . index,I,J,MYPE,STCK(index),SMCK(index),SH2OK(index) !x write(6,*)'SH2Ol2a:I,J,MYPE,N-1,N,N+1,' !x write(6,*)'STCK(N-1),STCK(N),STCK(N+1), =', !x . I,J,MYPE,indexm,index,indexp, !x . STCK(indexm),STCK(index),STCK(indexp) ! IERR1=1 !x ENDIF !x ELSEIF (STCK(index) .LT. T0-0.5) THEN ! Note SH2O, SMC when STC < -0.5C !x IF (SMCK(index)-SH2OK(index) .LT. 0.005) THEN !x write(6,*)'SH2Ol2b:INDEX,I,J,MYPE,STCK,SMC,SH2O=', !x . index,I,J,MYPE,STCK(index),SMCK(index),SH2OK(index) !x write(6,*)'SH2Ol2b:I,J,MYPE,N-1,N,N+1,' !x write(6,*) 'STCK(N-1),STCK(N),STCK(N+1), =', !x . I,J,MYPE,indexm,index,indexp, !x . STCK(indexm),STCK(index),STCK(indexp) ! IERR1=1 !x ENDIF !x ENDIF ! ---------------------------------------------------------------------- END DO ! ---------------------------------------------------------------------- ! Soil column bottom temp (TBOT) check ! IF ((TBOT .LT. 223.15) .OR. (TBOT .GT. 323.15)) THEN IF ((TBOT < 200.00) .OR. (TBOT > 323.15)) THEN write(6,*)'TBOTl:INDEX,I,J,MYPE,TBOT=', & index,I,J,MYPE,TBOT ! IERR2=1 ENDIF ! ---------------------------------------------------------------------- ! sfc/skin temp (T1K) check ! IF ((T1K .LT. 223.15) .OR. (T1K .GT. 323.15)) THEN ! IF ((T1K .LT. 200.00) .OR. (T1K .GT. 323.15)) THEN ! write(6,*)'T1:INDEX,I,J,MYPE,T1=', ! . index,I,J,MYPE,T1K ! IERR2=1 ! ENDIF ! ---------------------------------------------------------------------- ! Canopy water content (CMC) check IF ((CMCK < 0.) .OR. (CMCK > 0.5E-3)) THEN write(6,*)'CMC:INDEX,I,J,MYPE,CMC=', & index,I,J,MYPE,CMCK ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- ! Snow water equivalent, snow depth check ! IF (((SNODPK .GT. 0.) .AND. (SNOWH .LT. 1.0E-09)) .OR. ! . ((SNODPK .LT. 1.0E-09) .AND. (SNOWH .GT. 0.)) .OR. ! . (SNODPK .GT. SNOWH)) THEN ! WRITE(6,*)'SNOW:I,J,MYPE,SNODPK,SNOWH=', ! . I,J,MYPE,SNODPK,SNOWH ! IERR1=1 ! ENDIF ! ---------------------------------------------------------------------- ! Snow density check ! IF (SNODPK .GT. 0.) THEN ! SNDENS=SNODPK/SNOWH ! IF (SNDENS .LT. 0.05) THEN ! WRITE(6,*)'SNDENS<5%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', ! . I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ! ENDIF ! IF (SNDENS .GT. 0.40) THEN ! WRITE(6,*)'SNDENS>40%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', ! . I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ! ENDIF ! ENDIF ! ---------------------------------------------------------------------- ! end land checks ! ---------------------------------------------------------------------- ELSE ! ---------------------------------------------------------------------- ! sea-ice checks next ! ---------------------------------------------------------------------- ! sea-ice bottom temp (TBOT) check IF ( (TBOT < 271.159) .OR. & (TBOT > 271.161) ) THEN WRITE(6,*)'TBOTi:INDEX,I,J,MYPE,TBOT=', & index,I,J,MYPE,TBOT ENDIF ! ---------------------------------------------------------------------- ! sea-ice temp with depth (STC) range check DO index=1,4 ! IF ((STCK(index) .LT. 223.15) .OR. IF ((STCK(index) < 200.00) .OR. & ! . (STCK(index) .GT. 323.15)) THEN (STCK(index) > 274.15)) THEN write(6,*)'STCi:INDEX,I,J,MYPE,STC=', & index,I,J,MYPE,STCK(index) ! IERR1=2 ENDIF END DO ! ---------------------------------------------------------------------- ! sfc/skin temp (T1K) check ! IF ((T1K .LT. 223.15) .OR. (T1K .GT. 323.15)) THEN ! IF ((T1K .LT. 200.00) .OR. (T1K .GT. 323.15)) THEN ! write(6,*)'T1:INDEX,I,J,MYPE,ICE,T1=', ! . index,I,J,MYPE,ICE,T1K ! IERR2=1 ! ENDIF ! ---------------------------------------------------------------------- ! Snow water equivalent, snow depth check ! IF (((SNODPK .GT. 0.) .AND. (SNOWH .LT. 1.0E-09)) .OR. ! . ((SNODPK .LT. 1.0E-09) .AND. (SNOWH .GT. 0.)) .OR. ! . (SNODPK .GT. SNOWH)) THEN ! WRITE(6,*)'SNOW:I,J,MYPE,SNODPK,SNOWH=', ! . I,J,MYPE,SNODPK,SNOWH ! IERR1=1 ! ENDIF ! ---------------------------------------------------------------------- ! Snow density check ! IF (SNODPK .GT. 0.) THEN ! SNDENS=SNODPK/SNOWH ! IF (SNDENS .LT. 0.05) THEN ! WRITE(6,*)'SNDENS<5%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', ! . I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ! ENDIF ! IF (SNDENS .GT. 0.40) THEN ! WRITE(6,*)'SNDENS>40%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', ! . I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ! ENDIF ! ENDIF ! ---------------------------------------------------------------------- ! Check to see that when sea-ice, ALBASE=ALBEDO=0.6,MXSNAL=0, IF ( (ALB < 0.59) .OR. & (ALB > 0.61) .OR. & (ALBEDO(I,J) < 0.59) .OR. & (ALBEDO(I,J) > 0.61) .OR. & (SNOALB > 1.E-9) ) THEN ! p WRITE(6,*)'ALBi:I,J,MYPE,ICE,SNODPK,ALB,ALB2D,SNOALB=', ! p . I,J,MYPE,ICE,SNODPK,ALB,ALBEDO(I,J),SNOALB ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- ! Check to see that when sea-ice, SH2O=SMC=1.0 DO index=1,4 IF ( (SMCK(index) /= 1.0) .OR. & (SMCK(index) /= SH2OK(index)) ) THEN write(6,*)'SMCi:INDEX,I,J,MYPE,ICE,STCK,SMC,SH2O=', & index,I,J,MYPE,ICE,STCK(index),SMCK(index),SH2OK(index) ! IERR1=1 ENDIF END DO ! ---------------------------------------------------------------------- ! check to see that veg type=soil type=veg frac=0 ! IF ( (IVGTYP(I,J) .NE. 0 ) .OR. ! . (ISLTYP(I,J) .NE. 0 ) .OR. ! . (VGFRCK .GT. 0.) ) THEN ! WRITE(6,*)'IVGTYPi:I,J,MYPE,IVGTYP,ISLTYP,VGFRCK=', ! . I,J,MYPE,IVGTYP(I,J),ISLTYP(I,J),VGFRCK ! WRITE(6,*)'IVGTYPi:I,J,MYPE,SNODPK,ALB,ALBEDO,SNOALB=', ! . I,J,MYPE,SNODPK,ALB,ALBEDO(I,J),SNOALB ! ENDIF ! ---------------------------------------------------------------------- ! end sea-ice checks ! end of separate land AND sea-ice checks ! ---------------------------------------------------------------------- ENDIF ! ---------------------------------------------------------------------- ! both land AND sea-ice checks ! Snow water equivalent, snow depth check IF (((SNODPK > 0.) .AND. (SNOWH <= 0.)) .OR. & ((SNODPK <= 0.) .AND. (SNOWH > 0.)) .OR. & (SNODPK > SNOWH)) THEN WRITE(6,*)'SNOW:I,J,MYPE,SNODPK,SNOWH=', & I,J,MYPE,SNODPK,SNOWH ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- ! Snow density check IF (SNODPK > 0.) THEN SNDENS=SNODPK/SNOWH IF (SNDENS < 0.05) THEN WRITE(6,*)'SNDENS<5%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', & I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ENDIF IF (SNDENS > 0.40) THEN WRITE(6,*)'SNDENS>40%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', & I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ENDIF ENDIF ! ---------------------------------------------------------------------- ! sfc/skin temp (T1K) check ! IF ((T1K .LT. 223.15) .OR. (T1K .GT. 323.15)) THEN IF ((T1K < 200.00) .OR. (T1K > 323.15)) THEN write(6,*)'T1:INDEX,I,J,MYPE,T1=', & index,I,J,MYPE,T1K ! IERR2=1 ENDIF ! ---------------------------------------------------------------------- ! check to see that 223.15K (-50C) =< SFCTMP,SFCTH2 <= 323.15K (+50C) ! SFCTMP = lowest model level temp ! SFCTH2 = lowest model level pot temp IF ( ( (SFCTMP < 223.15) .OR. (SFCTMP > 323.15) ) .OR. & ( (SFCTH2 < 223.15) .OR. (SFCTH2 > 323.15) ) ) THEN WRITE(6,*)'SFCTMP:I,J,MYPE,SFCTMP,SFCTH2=', & I,J,MYPE,SFCTMP,SFCTH2 ENDIF ! ---------------------------------------------------------------------- ! check to see that 0W/m2 =< LWDN <= 500W/m2 ! check to see that 0W/m2 =< SOLDN <= 1200W/m2 ! LWDN = downward longwave radiation ! SOLDN = downward solar radiation IF ( ( (LWDN < 0.) .OR. (LWDN > 500.) ) .OR. & ( (SOLDN < 0.) .OR. (SOLDN > 1200.) ) ) THEN WRITE(6,*)'LWSOLDN:I,J,MYPE,LWDN,SOLDN=', & I,J,MYPE,LWDN,SOLDN ENDIF ! ---------------------------------------------------------------------- ! check to see that 0g/kg < Q2K,Q2SAT <= 40g/kg ! check to see that Q2K <= Q2SAT ! Q2K = lowest model level spec hum ! Q2SAT = lowest model level sat spec hum IF ( ( (Q2K <= 0.) .OR. (Q2K > 0.04) ) .OR. & ( (Q2SAT <= 0.) .OR. (Q2SAT > 0.04) ) .OR. & (Q2K > Q2SAT) ) THEN WRITE(6,*)'Q2:I,J,MYPE,Q2K,Q2SAT=', & I,J,MYPE,Q2K,Q2SAT ENDIF ! ---------------------------------------------------------------------- ! check to see that 600mb =< SFCPRS <= 1050mb ! SFCPRS = surface pressure (Pa) IF ( (SFCPRS <= 60000.) .OR. (SFCPRS > 105000.) ) THEN WRITE(6,*)'SFCPRS:I,J,MYPE,SFCPRS=', & I,J,MYPE,SFCPRS ENDIF ! ---------------------------------------------------------------------- ! check to see that 0 =< PRCP <= 0.04 KG M-2 S-1 (=0.04mm/s = 144mm/hr) ! PRCP = precip rate (KG M-2 S-1) IF ( (PRCP < 0.) .OR. (PRCP > 0.04) ) THEN WRITE(6,*)'PRCP:I,J,MYPE,PRCP=', & I,J,MYPE,PRCP ENDIF ! ---------------------------------------------------------------------- ! check to see that 0m/s < CHK <= 0.1m/s ! CHK = sfc heat exchange coeff (m/s) IF ( (CHK <= 0.) .OR. (CHK > 0.1) ) THEN WRITE(6,*)'CH:I,J,MYPE,CHK=', & I,J,MYPE,CHK ENDIF ! ---------------------------------------------------------------------- ! IF (IERR2 .EQ. 1) WRITE(6,*) ! . 'RANGE CHECK IN SURFCE: EXTREME VALUES' ! ENDIF ! IF (IERR1 .EQ. 1) THEN ! WRITE(6,*) 'RANGE CHECK FAILURE IN SURFCE - STOP' ! STOP ! ENDIF ! ---------------------------------------------------------------------- ! End of initial (logical LFIRST) range check for variables/parameters. ENDIF ! ---------------------------------------------------------------------- ! Ek 18 jan 2000 - NEW CALL SFLX CALL SFLX & (ICE,DTK,Z,NSOIL,SLDPTH, & LWDN,SOLDN,SFCPRS,PRCP,SFCTMP,SFCTH2,Q2K,SFCSPD,Q2SAT,DQSDTK, & IVGTPK,ISLTPK,ISPTPK, & VGFRCK,PTU,TBOT,ALB,SNOALB, & CMCK,T1K,STCK,SMCK,SH2OK,SNOWH,SNODPK,ALB2D,CHK,CMK, & PLFLX,ELFLX,HFLX,GFLX,RNOF1K,RNOF2K,Q1K,SMELTK, & SOILQW,SOILQM,DUM1,DUM2,DUM3,DUM4) !----------------------------------------------------------------------- IF (LFIRSTa) THEN ! IF ( (LFIRST) .OR. ! . (NTSD .EQ. 2) .OR. ! . (NTSD .EQ. 3) .OR. ! . (NTSD .EQ. NTSTM/2) .OR. ! . (NTSD .EQ. NTSTM) ) THEN ! ---------------------------------------------------------------------- ! land OR sea-ice checks ! land checks first IF (ICE < 0.5) THEN ! ---------------------------------------------------------------------- ! albedo checks ! ALB = ALBASE(I,J) = snow free albedo ! min = 0.11 (Matthews data base) ! max = 0.75 (Matthews data base) ! ALBEDO(I,J) = dynamic albedo (=ALBASE when SNODPK=0) ! (=ALB2D on return from SFLX) ! SNOALB = MAXSNAL(I,J) = maximum snow albedo ! min = 0.21 (Robinson data base) ! max = 0.80 (Robinson data base) IF ( (ALB > SNOALB ) .OR. & (ALB > ALBEDO(I,J)) .OR. & (ALBEDO(I,J) > SNOALB ) ) THEN write(6,*)'ALBl1:I,J,MYPE,ICE,SNODPK,ALB,ALB2D,SNOALB=', & I,J,MYPE,ICE,SNODPK,ALB,ALBEDO(I,J),SNOALB ! IERR1=1 ENDIF IF ( (ALB < 0.10) .OR. & (ALB > 0.76) .OR. & (SNOALB < 0.20) .OR. & (SNOALB > 0.81) ) THEN write(6,*)'ALBl2:I,J,MYPE,ICE,SNODPK,ALB,ALB2D,SNOALB=', & I,J,MYPE,ICE,SNODPK,ALB,ALBEDO(I,J),SNOALB ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- ! Veg,soil,slope type, veg fraction, No. soil layers checks IF ( ( (IVGTPK < 1) .OR. (IVGTPK > 13) ) .OR. & ( (ISLTPK < 1) .OR. (ISLTPK > 9) ) .OR. & (ISPTPK /= 1) .OR. & ( (VGFRCK < 0.) .OR. (VGFRCK > 1.) ) .OR. & (NSOIL /= 4) ) THEN WRITE(6,*)'LANDSFC:I,J,MYPE,IVGTPK,ISLTPK,ISPTPK,VGFRCK=', & I,J,MYPE,IVGTPK,ISLTPK,ISPTPK,VGFRCK ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- DO index=1,NSOIL ! ---------------------------------------------------------------------- ! debug !x indexp = min(index+1,nsoil) !x indexm = max(index-1,1) ! ---------------------------------------------------------------------- ! Soil temp (STC) range check IF ((STCK(index) < 223.15) .OR. & ! IF ((STCK(index) .LT. 200.00) .OR. (STCK(index) > 323.15)) THEN write(6,*)'STCl:INDEX,I,J,MYPE,STC=', & index,I,J,MYPE,STCK(index) ! IERR1=2 ENDIF ! ---------------------------------------------------------------------- ! Total soil moisture (SMC) check IF ( (SMCK(index) < 0.02) .OR. & (SMCK(index) > 0.468) ) THEN write(6,*)'SMC:INDEX,I,J,MYPE,STCK,SMC,SH2O=', & index,I,J,MYPE,STCK(index),SMCK(index),SH2OK(index) ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- ! Liquid soil moisture<=total soil moisture (SH2O<=SMC) maximum check IF ( (SH2OK(index) < 0.02) .OR. & (SH2OK(index) > SMCK(index)) ) THEN write(6,*)'SH2Ol1:INDEX,I,J,MYPE,ICE,STCK,SMC,SH2O=', & index,I,J,MYPE,STCK(index),SMCK(index),SH2OK(index) ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- ! Note SH2O, SMC when STC > +0.5C !x IF (STCK(index) .GT. T0+0.5) THEN !x IF (SMCK(index)-SH2OK(index) .GT. 0.005) THEN !x write(6,*)'SH2Ol2a:INDEX,I,J,MYPE,STCK,SMC,SH2O=', !x . index,I,J,MYPE,STCK(index),SMCK(index),SH2OK(index) !x write(6,*)'SH2Ol2a:I,J,MYPE,N-1,N,N+1,' !x write(6,*)'STCK(N-1),STCK(N),STCK(N+1), =', !x . I,J,MYPE,indexm,index,indexp, !x . STCK(indexm),STCK(index),STCK(indexp) ! IERR1=1 !x ENDIF !x ELSEIF (STCK(index) .LT. T0-0.5) THEN ! Note SH2O, SMC when STC < -0.5C !x IF (SMCK(index)-SH2OK(index) .LT. 0.005) THEN !x write(6,*)'SH2Ol2b:INDEX,I,J,MYPE,STCK,SMC,SH2O=', !x . index,I,J,MYPE,STCK(index),SMCK(index),SH2OK(index) !x write(6,*)'SH2Ol2b:I,J,MYPE,N-1,N,N+1,' !x write(6,*) 'STCK(N-1),STCK(N),STCK(N+1), =', !x . I,J,MYPE,indexm,index,indexp, !x . STCK(indexm),STCK(index),STCK(indexp) ! IERR1=1 !x ENDIF !x ENDIF ! ---------------------------------------------------------------------- END DO ! ---------------------------------------------------------------------- ! Soil column bottom temp (TBOT) check ! IF ((TBOT .LT. 223.15) .OR. (TBOT .GT. 323.15)) THEN IF ((TBOT < 200.00) .OR. (TBOT > 323.15)) THEN write(6,*)'TBOTl:INDEX,I,J,MYPE,TBOT=', & index,I,J,MYPE,TBOT ! IERR2=1 ENDIF ! ---------------------------------------------------------------------- ! sfc/skin temp (T1K) check ! IF ((T1K .LT. 223.15) .OR. (T1K .GT. 323.15)) THEN ! IF ((T1K .LT. 200.00) .OR. (T1K .GT. 323.15)) THEN ! write(6,*)'T1:INDEX,I,J,MYPE,T1=', ! . index,I,J,MYPE,T1K ! IERR2=1 ! ENDIF ! ---------------------------------------------------------------------- ! Canopy water content (CMC) check IF ((CMCK < 0.) .OR. (CMCK > 0.5E-3)) THEN write(6,*)'CMC:INDEX,I,J,MYPE,CMC=', & index,I,J,MYPE,CMCK ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- ! Snow water equivalent, snow depth check ! IF (((SNODPK .GT. 0.) .AND. (SNOWH .LT. 1.0E-09)) .OR. ! . ((SNODPK .LT. 1.0E-09) .AND. (SNOWH .GT. 0.)) .OR. ! . (SNODPK .GT. SNOWH)) THEN ! WRITE(6,*)'SNOW:I,J,MYPE,SNODPK,SNOWH=', ! . I,J,MYPE,SNODPK,SNOWH ! IERR1=1 ! ENDIF ! ---------------------------------------------------------------------- ! Snow density check ! IF (SNODPK .GT. 0.) THEN ! SNDENS=SNODPK/SNOWH ! IF (SNDENS .LT. 0.05) THEN ! WRITE(6,*)'SNDENS<5%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', ! . I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ! ENDIF ! IF (SNDENS .GT. 0.40) THEN ! WRITE(6,*)'SNDENS>40%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', ! . I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ! ENDIF ! ENDIF ! ---------------------------------------------------------------------- ! end land checks ! ---------------------------------------------------------------------- ELSE ! ---------------------------------------------------------------------- ! sea-ice checks next ! ---------------------------------------------------------------------- ! sea-ice bottom temp (TBOT) check IF ( (TBOT < 271.159) .OR. & (TBOT > 271.161) ) THEN WRITE(6,*)'TBOTi:INDEX,I,J,MYPE,TBOT=', & index,I,J,MYPE,TBOT ENDIF ! ---------------------------------------------------------------------- ! sea-ice temp with depth (STC) range check DO index=1,4 ! IF ((STCK(index) .LT. 223.15) .OR. IF ((STCK(index) < 200.00) .OR. & ! . (STCK(index) .GT. 323.15)) THEN (STCK(index) > 274.15)) THEN write(6,*)'STCi:INDEX,I,J,MYPE,STC=', & index,I,J,MYPE,STCK(index) ! IERR1=2 ENDIF END DO ! ---------------------------------------------------------------------- ! sfc/skin temp (T1K) check ! IF ((T1K .LT. 223.15) .OR. (T1K .GT. 323.15)) THEN ! IF ((T1K .LT. 200.00) .OR. (T1K .GT. 323.15)) THEN ! write(6,*)'T1:INDEX,I,J,MYPE,ICE,T1=', ! . index,I,J,MYPE,ICE,T1K ! IERR2=1 ! ENDIF ! ---------------------------------------------------------------------- ! Snow water equivalent, snow depth check ! IF (((SNODPK .GT. 0.) .AND. (SNOWH .LT. 1.0E-09)) .OR. ! . ((SNODPK .LT. 1.0E-09) .AND. (SNOWH .GT. 0.)) .OR. ! . (SNODPK .GT. SNOWH)) THEN ! WRITE(6,*)'SNOW:I,J,MYPE,SNODPK,SNOWH=', ! . I,J,MYPE,SNODPK,SNOWH ! IERR1=1 ! ENDIF ! ---------------------------------------------------------------------- ! Snow density check ! IF (SNODPK .GT. 0.) THEN ! SNDENS=SNODPK/SNOWH ! IF (SNDENS .LT. 0.05) THEN ! WRITE(6,*)'SNDENS<5%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', ! . I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ! ENDIF ! IF (SNDENS .GT. 0.40) THEN ! WRITE(6,*)'SNDENS>40%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', ! . I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ! ENDIF ! ENDIF ! ---------------------------------------------------------------------- ! Check to see that when sea-ice, ALBASE=ALBEDO=0.6,MXSNAL=0, IF ( (ALB < 0.59) .OR. & (ALB > 0.61) .OR. & (ALBEDO(I,J) < 0.59) .OR. & (ALBEDO(I,J) > 0.61) .OR. & (SNOALB > 1.E-9) ) THEN WRITE(6,*)'ALBi:I,J,MYPE,ICE,SNODPK,ALB,ALB2D,SNOALB=', & I,J,MYPE,ICE,SNODPK,ALB,ALBEDO(I,J),SNOALB ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- ! Check to see that when sea-ice, SH2O=SMC=1.0 DO index=1,4 IF ( (SMCK(index) /= 1.0) .OR. & (SMCK(index) /= SH2OK(index)) ) THEN write(6,*)'SMCi:INDEX,I,J,MYPE,ICE,STCK,SMC,SH2O=', & index,I,J,MYPE,ICE,STCK(index),SMCK(index),SH2OK(index) ! IERR1=1 ENDIF END DO ! ---------------------------------------------------------------------- ! check to see that veg type=soil type=veg frac=0 ! IF ( (IVGTYP(I,J) .NE. 0 ) .OR. ! . (ISLTYP(I,J) .NE. 0 ) .OR. ! . (VGFRCK .GT. 0.) ) THEN ! WRITE(6,*)'IVGTYPi:I,J,MYPE,IVGTYP,ISLTYP,VGFRCK=', ! . I,J,MYPE,IVGTYP(I,J),ISLTYP(I,J),VGFRCK ! WRITE(6,*)'IVGTYPi:I,J,MYPE,SNODPK,ALB,ALBEDO,SNOALB=', ! . I,J,MYPE,SNODPK,ALB,ALBEDO(I,J),SNOALB ! ENDIF ! ---------------------------------------------------------------------- ! end sea-ice checks ! end of separate land AND sea-ice checks ! ---------------------------------------------------------------------- ENDIF ! ---------------------------------------------------------------------- ! both land AND sea-ice checks ! Snow water equivalent, snow depth check IF (((SNODPK > 0.) .AND. (SNOWH <= 0.)) .OR. & ((SNODPK <= 0.) .AND. (SNOWH > 0.)) .OR. & (SNODPK > SNOWH)) THEN WRITE(6,*)'SNOW:I,J,MYPE,SNODPK,SNOWH=', & I,J,MYPE,SNODPK,SNOWH ! IERR1=1 ENDIF ! ---------------------------------------------------------------------- ! Snow density check IF (SNODPK > 0.) THEN SNDENS=SNODPK/SNOWH IF (SNDENS < 0.05) THEN WRITE(6,*)'SNDENS<5%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', & I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ENDIF IF (SNDENS > 0.40) THEN WRITE(6,*)'SNDENS>40%:I,J,MYPE,SNODPK,SNOWH,SNDENS=', & I,J,MYPE,SNODPK,SNOWH,SNDENS ! IERR1=1 ENDIF ENDIF ! ---------------------------------------------------------------------- ! sfc/skin temp (T1K) check ! IF ((T1K .LT. 223.15) .OR. (T1K .GT. 323.15)) THEN IF ((T1K < 200.00) .OR. (T1K > 323.15)) THEN write(6,*)'T1:INDEX,I,J,MYPE,T1=', & index,I,J,MYPE,T1K ! IERR2=1 ENDIF ! ---------------------------------------------------------------------- ! check to see that 223.15K (-50C) =< SFCTMP,SFCTH2 <= 323.15K (+50C) ! SFCTMP = lowest model level temp ! SFCTH2 = lowest model level pot temp IF ( ( (SFCTMP < 223.15) .OR. (SFCTMP > 323.15) ) .OR. & ( (SFCTH2 < 223.15) .OR. (SFCTH2 > 323.15) ) ) THEN WRITE(6,*)'SFCTMP:I,J,MYPE,SFCTMP,SFCTH2=', & I,J,MYPE,SFCTMP,SFCTH2 ENDIF ! ---------------------------------------------------------------------- ! check to see that 0W/m2 =< LWDN <= 500W/m2 ! check to see that 0W/m2 =< SOLDN <= 1200W/m2 ! LWDN = downward longwave radiation ! SOLDN = downward solar radiation IF ( ( (LWDN < 0.) .OR. (LWDN > 500.) ) .OR. & ( (SOLDN < 0.) .OR. (SOLDN > 1200.) ) ) THEN WRITE(6,*)'LWSOLDN:I,J,MYPE,LWDN,SOLDN=', & I,J,MYPE,LWDN,SOLDN ENDIF ! ---------------------------------------------------------------------- ! check to see that 0g/kg < Q2K,Q2SAT <= 40g/kg ! check to see that Q2K <= Q2SAT ! Q2K = lowest model level spec hum ! Q2SAT = lowest model level sat spec hum IF ( ( (Q2K <= 0.) .OR. (Q2K > 0.04) ) .OR. & ( (Q2SAT <= 0.) .OR. (Q2SAT > 0.04) ) .OR. & (Q2K > Q2SAT) ) THEN WRITE(6,*)'Q2:I,J,MYPE,Q2K,Q2SAT=', & I,J,MYPE,Q2K,Q2SAT ENDIF ! ---------------------------------------------------------------------- ! check to see that 600mb =< SFCPRS <= 1050mb ! SFCPRS = surface pressure (Pa) IF ( (SFCPRS <= 60000.) .OR. (SFCPRS > 105000.) ) THEN WRITE(6,*)'SFCPRS:I,J,MYPE,SFCPRS=', & I,J,MYPE,SFCPRS ENDIF ! ---------------------------------------------------------------------- ! check to see that 0 =< PRCP <= 0.04 KG M-2 S-1 (=0.04mm/s = 144mm/hr) ! PRCP = precip rate (KG M-2 S-1) IF ( (PRCP < 0.) .OR. (PRCP > 0.04) ) THEN WRITE(6,*)'PRCP:I,J,MYPE,PRCP=', & I,J,MYPE,PRCP ENDIF ! ---------------------------------------------------------------------- ! check to see that 0m/s < CHK <= 0.1m/s ! CHK = sfc heat exchange coeff (m/s) IF ( (CHK <= 0.) .OR. (CHK > 0.1) ) THEN WRITE(6,*)'CH:I,J,MYPE,CHK=', & I,J,MYPE,CHK ENDIF ! ---------------------------------------------------------------------- ! IF (IERR2 .EQ. 1) WRITE(6,*) ! . 'RANGE CHECK IN SURFCE: EXTREME VALUES' ! ENDIF ! IF (IERR1 .EQ. 1) THEN ! WRITE(6,*) 'RANGE CHECK FAILURE IN SURFCE - STOP' ! STOP ! ENDIF ! ---------------------------------------------------------------------- ! End of initial (logical LFIRST) range check for variables/parameters. ENDIF ! ---------------------------------------------------------------------- SCHECK=Z*CHK IF(SCHECK <= 1.3E-3)THEN PLFLX=0. ELFLX=0. ENDIF !*** !*** GCIP DIAGNOSTICS & MODIFICATION OF QFC1 OVER SNOW !*** SSROFF(I,J)=SSROFF(I,J)+RNOF1K*DTQ2 BGROFF(I,J)=BGROFF(I,J)+RNOF2K*DTQ2 SMSTAV(I,J)=SOILQW SOILTB(I,J)=TBOT SFCEXC(I,J)=CHK GRNFLX(I,J)=GFLX IF(SNO (I,J) > 0. .OR. SICE(I,J) > 0.5)THEN QFC1(I,J)=QFC1(I,J)*RLIVWV ENDIF IF(SNO(I,J) > 0.)THEN ACSNOM(I,J)=ACSNOM(I,J)+SMELTK SNOPCX(I,J)=SNOPCX(I,J)-SMELTK/FDTLIW ENDIF POTEVP(I,J)=POTEVP(I,J)+PLFLX*FDTW POTFLX(I,J)=POTFLX(I,J)-PLFLX SUBSHX(I,J)=SUBSHX(I,J)+GFLX !*** !*** ETA MODEL LOWER BOUNDARY CONDITIONS !*** ! THS(I,J)=THLM(I,J)+HFLX*APES(I,J)/FFS(I,J) THS(I,J)=T1K*APES(I,J) IF(QFC1(I,J) > 0.) & QS(I,J)=QLM(I,J)+ELFLX*APES(I,J)/QFC1(I,J) !*** !*** HISTORICAL VARIABLES !*** ! dynamic albedo, ALBEDO, to be passed to RADTN.f ALBEDO(I,J)=ALB2D SNO(I,J)=SNODPK ! snow depth, SI SI(I,J)=SNOWH CMC(I,J)=CMCK SMSTOT(I,J)=SOILQM DO 150 NS=1,NSOIL SMC(I,J,NS)=SMCK(NS) ! SH2O array (liquid soil moisture) SH2O(I,J,NS)=SH2OK(NS) STC(I,J,NS)=STCK(NS) 150 END DO ENDIF 155 END DO 160 END DO ! ---------------------------------------------------------------------- ! Set LFIRST=false so that there are not variable/parameter range checks ! for the next 155/160 loop LFIRSTa = .FALSE. LFIRST = .FALSE. !*** VARIABLES TWBS AND QWBS COMPUTED HERE FOR GCIP. !*** ACCUMULATE SURFACE HEAT FLUXES HERE. !*** FOR GCIP ACCUMULATE ACTUAL AND POTENTIAL EVAPORATION. !*** FOR GCIP ACCUMULATE TOTAL SNOW MELT AND !*** THE ASSOCIATED NET HEAT FLUX. ! omp parallel do private(i,j) DO 200 J=MYJS2,MYJE2 DO 200 I=MYIS,MYIE TWBS(I,J)=(THLM(I,J)-THS(I,J)*(1.-SM(I,J))-THZ0(I,J)*SM(I,J)) & *FFS (I,J)/APES(I,J) QWBS(I,J)=(QLM (I,J)-QS (I,J)*(1.-SM(I,J))-QZ0 (I,J)*SM(I,J)) & *QFC1(I,J)/APES(I,J) SFCSHX(I,J)=SFCSHX(I,J)+TWBS(I,J) SFCLHX(I,J)=SFCLHX(I,J)+QWBS(I,J) SFCEVP(I,J)=SFCEVP(I,J)-QWBS(I,J)*FDTW POTEVP(I,J)=POTEVP(I,J)-QWBS(I,J)*SM(I,J)*FDTW POTFLX(I,J)=POTFLX(I,J)+QWBS(I,J)*SM(I,J) !*** IF COLD ENOUGH, IT SNOWS (IN NOAH LSM)... !*** FOR GCIP ACCUMULATE TOTAL SNOWFALL. IF(THLM(I,J)/APELM(I,J) <= T0 .AND. SICE(I,J)+SM(I,J) < 0.5)THEN ACSNOW(I,J)=ACSNOW(I,J)+PREC(I,J) !*** !*** ... OTHERWISE IT RAINS. !*** ELSE ACCLIQ(I,J)=ACCLIQ(I,J)+PREC(I,J) ENDIF ! ule PD(I,J)=PD(I,J)-PREC(I,J)*GROW ! ule PREC(I,J)=0. 200 END DO !*** !*** LONGWAVE OUTGOING RADIATION !*** ! omp parallel do private(i,j,tsfc,tsfc2) DO 210 J=MYJS2,MYJE2 DO 210 I=MYIS,MYIE TSFC=THS(I,J)/APES(I,J) TSFC2=TSFC*TSFC RADOT(I,J)=HBM2(I,J)*EPSR(I,J)*STBOL*TSFC2*TSFC2 210 END DO !----------------------------------------------------------------------- ! INCREMENT TIME STEP COUNTERS FOR USE IN COMPUTING TIME AVE VALUES APHTIM = APHTIM + 1. ARDSW = ARDSW + 1. ARDLW = ARDLW + 1. ASRFC = ASRFC + 1. !----------------------------------------------------------------------- RETURN END SUBROUTINE SURFCE BLOCK DATA OPT COMMON /OPTIONS/ SPVAL,IBESSL,KSB,IOFFS,IFLAG,SATDEL DATA SPVAL / 99999 / DATA IBESSL / 0 / DATA KSB / 3 / DATA IOFFS / 2 / DATA IFLAG / 0 / DATA SATDEL / 0.05 / END BLOCK DATA OPT