SUBROUTINE NETAL(FLD3D,ITYPE,L,LMHLMV,EGRID) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . C SUBPROGRAM: NETAL EXTRACT ETA LAYER DATA. C PRGRMMR: TREADON ORG: W/NP2 DATE: 93-04-02 C C ABSTRACT: C THIS ROUTINE EXTRACTS FROM THE 3D ARRAY FLD3D ON EITHER C ETA LAYER L OR ATMOSPHERIC ETA LAYER L. BY "ETA LAYER L" C WE MEAN EXTRACTING DATA ON THE CONSTANT ETA LAYER L, C REGARDLESS OF THE MODEL TERRAIN. THIS IS SIMPLY A C HORIZONTAL SLICE THROUGH THE VOLUME FLD3D AT VERTICAL C LEVEL L. BY "ATMOSPHERIC ETA LAYER L WE MEAN THE TERRAIN C FOLLOWING LAYER CONSISTING OF ALL ETA LAYERS L LAYERS C ABOVE THE LOCAL MODEL SURFACE. C C INTEGER FLAG ITYPE CONTROLS WHICH TYPE OF ETA LAYER DATA C TO EXTRACT. FOR ITYPE=1 EXTRACT DATA ON CONSTANT ETA C LAYER L. FOR ITYPE GREATER THAN ONE EXTRACT DATA ON C ATMOSPHERIC ETA LAYER L. C . C C PROGRAM HISTORY LOG: C 93-04-02 RUSS TREADON C 98-06-08 T BLACK - CONVERSION FROM 1-D TO 2-D C 00-01-04 JIM TUCCILLO - MPI VERSION C C USAGE: CALL NETAL(FLD3D,ITYPE,L,LMHLMV,EGRID) C INPUT ARGUMENT LIST: C FLD3D - 3D VOLUME OF DATA ON ETA SURFACES. C ITYPE - FLAG CONTROLLING TYPE OF DATA EXTRACTION. C L - LEVEL TO EXTRACT. C LMHLMV - HORIZONTAL ARRAY CONTAINING VERTICAL INDEX C OF FIRST ATMOSPHERIC ETA LAYER. C C OUTPUT ARGUMENT LIST: C EGRID - HORIZONTAL ARRAY CONTAINING ETA LAYER DATA. C C OUTPUT FILES: C C C SUBPROGRAMS CALLED: C UTILITIES: C NONE C LIBRARY: C NONE C C ATTRIBUTES: C LANGUAGE: FORTRAN C MACHINE : CRAY C-90 C$$$ C C C C C INCLUDE PARAMETERS. INCLUDE "parmeta" INCLUDE "CTLBLK.comm" C C DECLARE VARIABLES. INTEGER LMHLMV(IM,JM) REAL EGRID(IM,JM), FLD3D(IM,JM,LM) C C C*************************************************************** C START NETAL HERE. C C C CASE WHEN ITYPE=1. C LOAD ETA LEVEL L INTO EGRID. C IF (ITYPE.EQ.1) THEN LGET = L DO J=JSTA,JEND DO I=1,IM EGRID(I,J) = FLD3D(I,J,LGET) ENDDO ENDDO C C CASE WHEN ITYPE.GT.1. C LOAD ATMOSPHERIC ETA LAYER L INTO EGRID. C ELSEIF (ITYPE.GT.1) THEN LOFF = L-1 DO J=JSTA,JEND DO I=1,IM LGET = LMHLMV(I,J) - LOFF IF (LGET.LT.01) LGET = 01 IF (LGET.GT.LM) LGET = LM EGRID(I,J) = FLD3D(I,J,LGET) ENDDO ENDDO ENDIF CX CX DEBUG PRINTS BELOW. CX CX IF (ITYPE.GT.1) THEN CX WRITE(81,*)' ' CX WRITE(81,*)'LISTING FOR NEW FIELD.' CX CALL MINMAX(EGRID,IM,JM,FMIN,FMAX) CX WRITE(81,*)' FMIN,FMAX: ',FMIN,FMAX CX DO J=JSTA,JEND CX DO I=1,IM CX LOFF = L-1 CX LGET = LMHLMV(I,J) - LOFF CX DIFF = FLD3D(I,J,LGET)-EGRID(I,J) CX IF (DIFF.NE.0.) WRITE(81,*)'WARNING: DIFF.NE.0.' CX WRITE(81,1234) I,J,L,LOFF,LMHLMV(I,J), CX X FLD3D(I,J,LGET),EGRID(I,J),DIFF CX 1234 FORMAT(I3,1X,I3,,1X,3(I2,1X),3(G12.6,1X)) CX END DO CX END IF C C END OF ROUTINE. C RETURN END