File: C:\NOAA\NEMS_11731\src\atmos\gfs\phys\para_nstio_w.f
1 SUBROUTINE PARA_NSTIO_W(IOPROC,nst_fld,nw,cfile,
2 & xhour,idate,global_lats_r,lonsperlar)
3
4 use resol_def
5 use layout1
6 use namelist_physics_def
7 use nstio_module
8 use gfs_physics_nst_var_mod
9 use machine, ONLY: kind_ior, kind_io8
10 implicit none
11
12 TYPE(Nst_Var_Data) :: nst_fld
13
14 integer nw,IOPROC
15 character*(*) cfile
16 real(kind=kind_io8) xhour
17 INTEGER GLOBAL_LATS_R(latr)
18 INTEGER lonsperlar(latr)
19
20
21 real(kind=kind_ior) buff4(lonr,latr)
22 real(kind=kind_io8) bfo(lonr,lats_node_r)
23 integer kmsk(lonr,lats_node_r)
24 integer idate(4),k
25
26 type(nstio_head) head
27 type(nstio_dbta) data
28 integer iret
29 logical first
30 save head, first
31 data first /.true./
32
33
34
35 if (me.eq.ioproc) then
36 if (first) then
37 head%clabnst= CHAR(0)//CHAR(0)//CHAR(0)//CHAR(0)//
38 & CHAR(0)//CHAR(0)//CHAR(0)//CHAR(0)
39 head%latb = latr
40 head%lonb = lonr
41 head%ivo = ivsnst
42 head%irealf = 2
43 head%lsea = lsea
44 call nstio_alhead(head,iret)
45 head%lpl = lonsperlar(1:latr/2)
46
47
48
49
50 = .false.
51 endif
52 head%fhour = xhour
53 head%idate = idate
54
55 call nstio_aldbta(head,data,iret)
56 PRINT 99,nw,xhour,IDATE,iret
57 99 FORMAT(1H ,'in para_nstio_w nw=',i7,2x,'HOUR=',f8.2,3x,'IDATE=',
58 & 4(1X,I4)),' iret=',I2
59 ENDIF
60
61 = nint(nst_fld%slmsk)
62
63 CALL uninterpred(1,kmsk,bfo,nst_fld%slmsk,
64 & global_lats_r,lonsperlar)
65 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
66 if(me.eq.ioproc) data%slmsk=buff4
67
68 CALL uninterpred(1,kmsk,bfo,nst_fld%xt,
69 & global_lats_r,lonsperlar)
70 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
71 if(me.eq.ioproc) data%xt=buff4
72
73 CALL uninterpred(1,kmsk,bfo,nst_fld%xs,
74 & global_lats_r,lonsperlar)
75 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
76 if(me.eq.ioproc) data%xs=buff4
77
78 CALL uninterpred(1,kmsk,bfo,nst_fld%xu,
79 & global_lats_r,lonsperlar)
80 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
81 if(me.eq.ioproc) data%xu=buff4
82
83 CALL uninterpred(1,kmsk,bfo,nst_fld%xv,
84 & global_lats_r,lonsperlar)
85 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
86 if(me.eq.ioproc) data%xv=buff4
87
88 CALL uninterpred(1,kmsk,bfo,nst_fld%xz,
89 & global_lats_r,lonsperlar)
90 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
91 if(me.eq.ioproc) data%xz=buff4
92
93 CALL uninterpred(1,kmsk,bfo,nst_fld%dt_cool,
94 & global_lats_r,lonsperlar)
95 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
96 if(me.eq.ioproc) data%dt_cool=buff4
97
98 CALL uninterpred(1,kmsk,bfo,nst_fld%z_c,
99 & global_lats_r,lonsperlar)
100 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
101 if(me.eq.ioproc) data%z_c=buff4
102
103 CALL uninterpred(1,kmsk,bfo,nst_fld%c_0,
104 & global_lats_r,lonsperlar)
105 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
106 if(me.eq.ioproc) data%c_0=buff4
107
108 CALL uninterpred(1,kmsk,bfo,nst_fld%c_d,
109 & global_lats_r,lonsperlar)
110 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
111 if(me.eq.ioproc) data%c_d=buff4
112
113 CALL uninterpred(1,kmsk,bfo,nst_fld%w_0,
114 & global_lats_r,lonsperlar)
115 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
116 if(me.eq.ioproc) data%w_0=buff4
117
118 CALL uninterpred(1,kmsk,bfo,nst_fld%w_d,
119 & global_lats_r,lonsperlar)
120 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
121 if(me.eq.ioproc) data%w_d=buff4
122
123 CALL uninterpred(1,kmsk,bfo,nst_fld%d_conv,
124 & global_lats_r,lonsperlar)
125 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
126 if(me.eq.ioproc) data%d_conv=buff4
127
128 CALL uninterpred(1,kmsk,bfo,nst_fld%ifd,
129 & global_lats_r,lonsperlar)
130 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
131 if(me.eq.ioproc) data%ifd=buff4
132
133 CALL uninterpred(1,kmsk,bfo,nst_fld%tref,
134 & global_lats_r,lonsperlar)
135 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
136 if(me.eq.ioproc) data%tref=buff4
137
138 CALL uninterpred(1,kmsk,bfo,nst_fld%qrain,
139 & global_lats_r,lonsperlar)
140 call unsplit2d_r(ioproc,buff4,bfo,global_lats_r)
141 if(me.eq.ioproc) data%qrain=buff4
142
143 if(me.eq.ioproc) then
144 call nstio_swohdc(nw,cfile,head,ngrids_nst,data,iret)
145 print *,' calling nstio_swohdc with nw=',nw,' cfile=',cfile
146 &,' ivo=',head%ivo,' idate=',head%idate,'iret=',iret
147 call nstio_axdbta(data,iret)
148 print*,' call nstio_axdbta, iret = ',iret
149 endif
150
151 return
152 end
153