File: C:\NOAA\NEMS_11731\src\atmos\gfs\dyn\input_fields.f
1 SUBROUTINE input_fields(cread, PDRYINI,TRIE_LS,TRIO_LS,grid_gr,
2 & LS_NODE,LS_NODES,MAX_LS_NODES,SNNP1EV,SNNP1OD,
3 & global_lats_a,lonsperlat,
4 & epse,epso,plnev_a,plnod_a,plnew_a,plnow_a,
5 & lats_nodes_a, pwat,ptot,ptrc)
6
7
8
9
10 use gfs_dyn_resol_def
11 use gfs_dyn_layout1
12 use gfs_dyn_gg_def
13 use gfs_dyn_vert_def
14 use gfs_dyn_date_def
15 use namelist_dynamics_def
16 use gfs_dyn_mpi_def
17 IMPLICIT NONE
18
19
20
21
22 REAL(KIND=kind_grid) PDRYINI
23 CHARACTER (len=*) :: CREAD
24 REAL(KIND=KIND_EVOD) TRIE_LS(LEN_TRIE_LS,2,LOTLS)
25 REAL(KIND=KIND_EVOD) TRIO_LS(LEN_TRIO_LS,2,LOTLS)
26 REAL(KIND=KIND_GRID) GRID_GR(lonf*lats_node_a_max,lotgr)
27 REAL(KIND=KIND_EVOD) SNNP1EV(LEN_TRIE_LS)
28 REAL(KIND=KIND_EVOD) SNNP1OD(LEN_TRIO_LS)
29 REAL(KIND=KIND_EVOD) EPSE (LEN_TRIE_LS)
30 REAL(KIND=KIND_EVOD) EPSO (LEN_TRIE_LS)
31 REAL(KIND=KIND_EVOD) PLNEV_a(LEN_TRIE_LS,latg2)
32 REAL(KIND=KIND_EVOD) PLNOD_a(LEN_TRIE_LS,latg2)
33 REAL(KIND=KIND_EVOD) PLNEW_a(LEN_TRIE_LS,latg2)
34 REAL(KIND=KIND_EVOD) PLNOW_a(LEN_TRIE_LS,latg2)
35
36 real(kind=kind_grid) zsg(lonf,lats_node_a)
37 real(kind=kind_grid) psg(lonf,lats_node_a)
38 real(kind=kind_grid) dpg(lonf,lats_node_a,levs)
39 real(kind=kind_grid) ttg(lonf,lats_node_a,levs)
40 real(kind=kind_grid) uug(lonf,lats_node_a,levs)
41 real(kind=kind_grid) vvg(lonf,lats_node_a,levs)
42 real(kind=kind_grid) rqg(lonf,lats_node_a,levh)
43
44 REAL(KIND=KIND_GRID) pwat (lonf,lats_node_a)
45 REAL(KIND=KIND_GRID) ptot (lonf,lats_node_a)
46 REAL(KIND=KIND_GRID) ptrc (lonf,lats_node_a,ntrac)
47
48 integer global_lats_a(latg), lonsperlat(latg)
49
50
51 INTEGER LS_NODE (LS_DIM*3)
52 INTEGER LS_NODES(LS_DIM,NODES)
53 INTEGER MAX_LS_NODES(NODES)
54 integer lats_nodes_a(nodes)
55
56 INTEGER IERR,IPRINT,J,JDT,K,L,LOCL,N,i
57 REAL(KIND=KIND_EVOD) TEE1(LEVS)
58 REAL(KIND=KIND_EVOD) YE1(LEVS)
59 INTEGER INDLSEV,JBASEV
60 INTEGER INDLSOD,JBASOD
61 REAL(KIND=KIND_EVOD), parameter :: CONS0=0.0, CONS2=2.0,
62 & CONS600=600.0
63 LOGICAL LSLAG
64 integer lan, lat, lons_lat, jlonf
65
66 if(me.eq.0) PRINT 9876,FHOUR,idate
67 9876 FORMAT(1H ,'FHOUR IN input_fields ',F6.2,
68 & ' idate no yet read in',4(1x,i4))
69 IPRINT = 0
70
71
72 if (me .eq. 0) write(0,*)'input field, cread=',cread,'ntoz=',ntoz
73 CALL TREADEO_nemsio(IDATE,
74 X TRIE_LS(1,1,P_GZ ), TRIE_LS(1,1,P_QM ),
75 X TRIE_LS(1,1,P_TEM), TRIE_LS(1,1,P_DIM),
76 X TRIE_LS(1,1,P_ZEM), TRIE_LS(1,1,P_RM ),
77 X TRIO_LS(1,1,P_GZ ), TRIO_LS(1,1,P_QM ),
78 X TRIO_LS(1,1,P_TEM), TRIO_LS(1,1,P_DIM),
79 X TRIO_LS(1,1,P_ZEM), TRIO_LS(1,1,P_RM ),
80 & zsg, psg, ttg, uug, vvg, rqg,
81 X LS_NODE,LS_NODES,MAX_LS_NODES,
82 X SNNP1EV,SNNP1OD,PDRYINI,IPRINT,
83 & global_lats_a,lats_nodes_a,lonsperlat, cread,
84 & epse, epso, plnew_a, plnow_a,
85 & plnev_a, plnod_a, pwat, ptot, ptrc)
86
87 do j=1,lats_node_a
88 jlonf=(j-1)*lonf
89 grid_gr(jlonf+1:jlonf+lonf,g_gz) = zsg(1:lonf,j)
90 grid_gr(jlonf+1:jlonf+lonf,g_qm) = psg(1:lonf,j)
91 enddo
92 do k=1,levs
93 do j=1,lats_node_a
94 jlonf=(j-1)*lonf
95 grid_gr(jlonf+1:jlonf+lonf,g_ttm+k-1) = ttg(1:lonf,j,k)
96 grid_gr(jlonf+1:jlonf+lonf,g_uum+k-1) = uug(1:lonf,j,k)
97 grid_gr(jlonf+1:jlonf+lonf,g_vvm+k-1) = vvg(1:lonf,j,k)
98 enddo
99 enddo
100 do k=1,levh
101 do j=1,lats_node_a
102 jlonf=(j-1)*lonf
103 grid_gr(jlonf+1:jlonf+lonf,g_rm +k-1) = rqg(1:lonf,j,k)
104 enddo
105 enddo
106
107
108 fhini=fhour
109 if(me.eq.0) PRINT 9877, FHOUR
110 9877 FORMAT(1H ,'FHOUR AFTER TREAD',F6.2)
111
112 if (me .eq. 0) write(0,*)' fhini=',fhini,'last_fcst_pe=',
113 & last_fcst_pe,'fhrot=',fhrot
114 if (me<=last_fcst_pe) then
115 CALL RMS_spect(TRIE_LS(1,1,P_QM ), TRIE_LS(1,1,P_DIM),
116 X TRIE_LS(1,1,P_TEM), TRIE_LS(1,1,P_ZEM),
117 X TRIE_LS(1,1,P_RM ),
118 X TRIO_LS(1,1,P_QM ), TRIO_LS(1,1,P_DIM),
119 X TRIO_LS(1,1,P_TEM), TRIO_LS(1,1,P_ZEM),
120 X TRIO_LS(1,1,P_RM ),
121 X LS_NODES,MAX_LS_NODES)
122 endif
123
124 if(fhini.eq.fhrot) THEN
125
126
127
128 do i=1,len_trie_ls
129 trie_ls(i,1,P_q )=trie_ls(i,1,P_qm )
130 trie_ls(i,2,P_q )=trie_ls(i,2,P_qm )
131 enddo
132 do i=1,len_trio_ls
133 trio_ls(i,1,P_q )=trio_ls(i,1,P_qm )
134 trio_ls(i,2,P_q )=trio_ls(i,2,P_qm )
135 enddo
136
137 do k=1,levs
138 do i=1,len_trie_ls
139 trie_ls(i,1,P_te +k-1)=trie_ls(i,1,P_tem +k-1)
140 trie_ls(i,2,P_te +k-1)=trie_ls(i,2,P_tem +k-1)
141
142 trie_ls(i,1,P_di +k-1)=trie_ls(i,1,P_dim +k-1)
143 trie_ls(i,2,P_di +k-1)=trie_ls(i,2,P_dim +k-1)
144
145 trie_ls(i,1,P_ze +k-1)=trie_ls(i,1,P_zem +k-1)
146 trie_ls(i,2,P_ze +k-1)=trie_ls(i,2,P_zem +k-1)
147 enddo
148 do i=1,len_trio_ls
149 trio_ls(i,1,P_te +k-1)=trio_ls(i,1,P_tem+k-1)
150 trio_ls(i,2,P_te +k-1)=trio_ls(i,2,P_tem+k-1)
151
152 trio_ls(i,1,P_di +k-1)=trio_ls(i,1,P_dim+k-1)
153 trio_ls(i,2,P_di +k-1)=trio_ls(i,2,P_dim+k-1)
154
155 trio_ls(i,1,P_ze +k-1)=trio_ls(i,1,P_zem+k-1)
156 trio_ls(i,2,P_ze +k-1)=trio_ls(i,2,P_zem+k-1)
157 enddo
158 enddo
159
160 do k=1,levh
161 do i=1,len_trie_ls
162 trie_ls(i,1,P_rq +k-1)=trie_ls(i,1,P_rm +k-1)
163 trie_ls(i,2,P_rq +k-1)=trie_ls(i,2,P_rm +k-1)
164 enddo
165 do i=1,len_trio_ls
166 trio_ls(i,1,P_rq +k-1)=trio_ls(i,1,P_rm+k-1)
167 trio_ls(i,2,P_rq +k-1)=trio_ls(i,2,P_rm+k-1)
168 enddo
169 enddo
170
171 (:,g_q )=grid_gr(:,g_qm )
172 grid_gr(:,g_tt:g_tt+levs-1)=grid_gr(:,g_ttm:g_ttm+levs-1)
173 grid_gr(:,g_uu:g_uu+levs-1)=grid_gr(:,g_uum:g_uum+levs-1)
174 grid_gr(:,g_vv:g_vv+levs-1)=grid_gr(:,g_vvm:g_vvm+levs-1)
175 grid_gr(:,g_rq:g_rq+levh-1)=grid_gr(:,g_rm :g_rm +levh-1)
176
177 endif
178
179
180
181 (:,g_zq)=grid_gr(:,g_q )
182 grid_gr(:,g_t :g_t +levs-1)=grid_gr(:,g_tt:g_tt+levs-1)
183 grid_gr(:,g_u :g_u +levs-1)=grid_gr(:,g_uu:g_uu+levs-1)
184 grid_gr(:,g_v :g_v +levs-1)=grid_gr(:,g_vv:g_vv+levs-1)
185 grid_gr(:,g_rt:g_rt+levh-1)=grid_gr(:,g_rq:g_rq+levh-1)
186
187
188
189 RETURN
190 END
191