REDANL.inc
References to this file elsewhere.
1 SUBROUTINE REDANL
2 I(NALFL ,IMAX ,JMAX ,KMAX ,
3 O IDATE ,AAD ,BBD ,AAM ,BBM ,CINF ,
4 O PS ,GZ ,GU ,GV ,GQ ,GT ,
5 O LARHM ,
6 W IDA ,TYPE ,EXPR ,KTUNIT,NPROD ,NPROM ,VCODD ,VCODM ,
7 W FILE ,MODEL ,RESL ,LEVEL ,ELEM ,TITLE ,UNIT )
8 C
9 INTEGER IDATE(5)
10 DIMENSION PS(IMAX*JMAX)
11 DIMENSION GZ(IMAX*JMAX,KMAX), GU(IMAX*JMAX,KMAX),
12 1 GV(IMAX*JMAX,KMAX), GQ(IMAX*JMAX,KMAX),
13 2 GT(IMAX*JMAX,KMAX)
14 CHARACTER*80 CINF(10)
15 DIMENSION AAD(KMAX+1), AAM(KMAX+1), BBD(KMAX+1), BBM(KMAX+1)
16 c INTEGER*2 IDA(IMAX*JMAX) !shc-rizvi
17 INTEGER IDA(IMAX*JMAX/2) !shc-rizvi
18 C
19 CHARACTER*4 TYPE, EXPR, KTUNIT, NPROD, NPROM, VCODD, VCODM
20 CHARACTER*8 FILE, MODEL, RESL
21 CHARACTER*4 LEVEL, ELEM
22 CHARACTER*32 TITLE
23 CHARACTER*16 UNIT
24 C
25 C
26 C =================================================================
27 C >>> HEADER <<<
28 C =================================================================
29 CALL REDHED
30 I(NALFL ,
31 O TYPE ,IDATE ,FILE ,MODEL ,RESL ,EXPR ,KTUNIT,IDTYPE,
32 O IBACK ,NNSP ,
33 O IMD ,JMD ,NPROD ,FLATID,FLONID,
34 O XID ,XJD ,XLATD ,XLOND ,
35 O VCODD ,KMD ,AAD ,BBD ,
36 O IMM ,JMM ,NPROM ,FLATIM,FLONIM,
37 O XIM ,XJM ,XLATM ,XLONM ,
38 O VCODM ,KMM ,AAM ,BBM ,
39 O CINF )
40 WRITE(6,*)'ANAL FILE ',IDATE, FILE, MODEL, RESL, EXPR
41 IF( FILE.NE.'ANALETA ' ) THEN
42 WRITE(6,*) 'FILE ERROR! THIS IS NOT ANAL DATA'
43 STOP 999
44 ENDIF
45 C
46 C =================================================================
47 C >>> SPECIAL <<<
48 C =================================================================
49 DO 10 I=1,NNSP
50 READ(NALFL)
51 10 CONTINUE
52 C
53 C =================================================================
54 C >>> PS <<<
55 C =================================================================
56 30 CALL REDDAT
57 I(NALFL ,
58 O IDATE , KT , LEVEL , ELEM , TITLE , UNIT , KTSD , KTSA ,
59 O PS , IRTN ,
60 I IMD , JMD , 1 ,
61 W BASE , AMP , IDA )
62 IF(.NOT.(LEVEL.EQ.'SURF'.AND.ELEM.EQ.'P ')) GOTO 30
63 C
64 C =================================================================
65 C >>> U <<<
66 C =================================================================
67 DO 110 K=1,KMAX
68 100 CALL REDDAT
69 I(NALFL ,
70 O IDATE , KT , LEVEL , ELEM , TITLE , UNIT , KTSD , KTSA ,
71 O GU(1,K), IRTN ,
72 I IMD , JMD , 1 ,
73 W BASE , AMP , IDA )
74 IF(LEVEL.EQ.'SURF'.OR.ELEM.NE.'U ') GOTO 100
75 110 CONTINUE
76 C =================================================================
77 C >>> V <<<
78 C =================================================================
79 DO 210 K=1,KMAX
80 200 CALL REDDAT
81 I(NALFL ,
82 O IDATE , KT , LEVEL , ELEM , TITLE , UNIT , KTSD , KTSA ,
83 O GV(1,K), IRTN ,
84 I IMD , JMD , 1 ,
85 W BASE , AMP , IDA )
86 IF(LEVEL.EQ.'SURF'.OR.ELEM.NE.'V ') GOTO 200
87 210 CONTINUE
88 C =================================================================
89 C >>> Z <<<
90 C =================================================================
91 DO 310 K=1,KMAX
92 300 CALL REDDAT
93 I(NALFL ,
94 O IDATE , KT , LEVEL , ELEM , TITLE , UNIT , KTSD , KTSA ,
95 O GZ(1,K), IRTN ,
96 I IMD , JMD , 1 ,
97 W BASE , AMP , IDA )
98 IF(LEVEL.EQ.'SURF'.OR.ELEM.NE.'Z ') GOTO 300
99 310 CONTINUE
100 C =================================================================
101 C >>> T <<<
102 C =================================================================
103 DO 320 K=1,KMAX
104 330 CALL REDDAT
105 I(NALFL ,
106 O IDATE , KT , LEVEL , ELEM , TITLE , UNIT , KTSD , KTSA ,
107 O GT(1,K), IRTN ,
108 I IMD , JMD , 1 ,
109 W BASE , AMP , IDA )
110 IF(LEVEL.EQ.'SURF'.OR.ELEM.NE.'T ') GOTO 330
111 320 CONTINUE
112 C =================================================================
113 C >>> RH, Q <<<
114 C =================================================================
115 LARHM=1
116 DO 410 K=1,KMAX
117 400 CALL REDDAT
118 I(NALFL ,
119 O IDATE , KT , LEVEL , ELEM , TITLE , UNIT , KTSD , KTSA ,
120 O GQ(1,K), IRTN ,
121 I IMD , JMD , 1 ,
122 W BASE , AMP , IDA )
123 IF(LEVEL.EQ.'SURF'.OR.(ELEM.NE.'RH '.AND.ELEM.NE.'Q '))
124 1 GOTO 400
125 IF(ELEM.EQ.'RH ') LARHM=LARHM+1
126 410 CONTINUE
127 C
128 WRITE(6,*) '## READ ANAL-ETA NORMAL END'
129 RETURN
130 END SUBROUTINE REDANL