UPP (develop)
Loading...
Searching...
No Matches
ASSIGNNEMSIOVAR.f
1 subroutine assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u,l,nrec, &
2 fldsize,spval,tmp,recname,reclevtyp, &
3 reclev,VarName,VcoordName,buf)
4!
5 use ctlblk_mod, only: me
6 implicit none
7 include "mpif.h"
8!
9 integer, intent(in) :: im,jsta,jend,jsta_2l,jend_2u,l,nrec,fldsize
10 integer, intent(in) :: reclev(nrec)
11 real, intent(in) :: spval,tmp(fldsize*nrec)
12 character(*),intent(in) :: recname(nrec)
13 character(*),intent(in) :: reclevtyp(nrec)
14 character(*),intent(in) :: VarName,VcoordName
15 real, intent(out) :: buf(im,jsta_2l:jend_2u)
16 integer :: fldst,recn,js,j,i
17
18 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
19 if(recn /= 0) then
20 fldst = (recn-1)*fldsize
21 do j=jsta,jend
22 js = (j-jsta)*im
23 do i=1,im
24 buf(i,j) = tmp(i+js+fldst)
25 enddo
26 enddo
27 else
28 if(jsta == 1 .and. me == 0) print*,'fail to read ', &
29 varname,vcoordname,l ,' assign missing value'
30 buf = spval
31 endif
32
33
34 RETURN
35 END
36
37!-----------------------------------------------------------------------
38!#######################################################################
39!-----------------------------------------------------------------------
40!
41 SUBROUTINE getrecn(recname,reclevtyp,reclev,nrec,fldname, &
42 fldlevtyp,fldlev,recn)
43!-----------------------------------------------------------------------
44!-- this subroutine searches the field list to find out a specific field,
45!-- and return the field number for that field
46!-----------------------------------------------------------------------
47!
48 use ctlblk_mod, only: me
49 implicit none
50!
51 integer,intent(in) :: nrec
52 character(*),intent(in) :: recname(nrec)
53 character(*),intent(in) :: reclevtyp(nrec)
54 integer,intent(in) :: reclev(nrec)
55 character(*),intent(in) :: fldname
56 character(*),intent(in) :: fldlevtyp
57 integer,intent(in) :: fldlev
58 integer,intent(out) :: recn
59!
60 integer i
61!
62 recn=0
63 do i=1,nrec
64 if(trim(recname(i)) == trim(fldname) .and. &
65 trim(reclevtyp(i)) == trim(fldlevtyp) .and. &
66 reclev(i) == fldlev) then
67 recn = i
68 return
69 endif
70 enddo
71!
72 if(recn == 0 .and. me == 0) print *,'WARNING: field ', &
73 trim(fldname),' ', trim(fldlevtyp),' ', &
74 fldlev,' is not in the nemsio file!'
75!
76!-----------------------------------------------------------------------
77!
78 END SUBROUTINE getrecn