/[MITgcm]/MITgcm/pkg/fizhi/fizhi_init_vegsurftiles.F
ViewVC logotype

Diff of /MITgcm/pkg/fizhi/fizhi_init_vegsurftiles.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by molod, Wed May 4 22:16:04 2005 UTC revision 1.10 by molod, Mon Jul 9 15:07:14 2007 UTC
# Line 44  C     !LOCAL VARIABLES: Line 44  C     !LOCAL VARIABLES:
44        integer bislot,bjslot,iunit        integer bislot,bjslot,iunit
45        integer recl        integer recl
46        integer bi,bj,fileprec        integer bi,bj,fileprec
47        Real*8 globalarr(Nx,Ny,8)        integer xsize, ysize
48    #if defined(ALLOW_EXCH2)
49           PARAMETER ( xsize = exch2_domain_nxt * sNx )
50           PARAMETER ( ysize = exch2_domain_nyt * sNy )
51    #else
52           PARAMETER ( xsize = Nx )
53           PARAMETER ( ysize = Ny )
54    #endif
55          Real*8 globalarr(xsize,ysize,8)
56        _RL tempgrid(sNx,sNy)        _RL tempgrid(sNx,sNy)
57        _RL temptile(nchp)        _RL temptile(nchp)
58          _RL fracland(sNx,sNy,Nsx,Nsy)
59    
60        ihour = nhms/10000        ihour = nhms/10000
61        WRITE(fn,'(a,I8,a,I2.2,a)') 'vegtiles_cs32.d',nymd,'z',ihour,'.bin'        if(xsize.eq.192) then
62          WRITE(fn,'(a,I8,a,I2.2,a)')
63         .            'vegtiles_cs32.d',nymd,'z',ihour,'.bin'
64          elseif(xsize.eq.612) then
65          WRITE(fn,'(a,I8,a,I2.2,a)')
66         .            'vegtiles_cs102.d',nymd,'z',ihour,'.bin'
67          else
68          print *,' xsize is ',xsize
69          stop 'do not seem to have correct vegtiles data '
70          endif
71        fileprec = 64        fileprec = 64
72    
73        call MDSFINDUNIT( iunit, mythid )        call MDSFINDUNIT( iunit, mythid )
# Line 58  C     !LOCAL VARIABLES: Line 76  C     !LOCAL VARIABLES:
76  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
77        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
78    
       print *,' Opening ',fn  
79        open(iUnit,file=fn,status='old',access='direct',recl=recl)        open(iUnit,file=fn,status='old',access='direct',recl=recl)
80        read(iunit,rec=1) globalarr        read(iunit,rec=1) globalarr
81        close( iunit )        close( iunit )
# Line 80  C Only do I/O if I am the master thread Line 97  C Only do I/O if I am the master thread
97         bjslot = myYGlobalLo-1+(bj-1)*sNy         bjslot = myYGlobalLo-1+(bj-1)*sNy
98  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
99    
100         do j = 1,sNx        call get_landfrac(sNx,sNy,Nsx,Nsy,bi,bj,maxtyp,
101         .        surftype,tilefrac,fracland(1,1,bi,bj))
102    
103           do j = 1,sNy
104         do i = 1,sNx         do i = 1,sNx
105          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,1)          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,1)
106         enddo         enddo
107         enddo         enddo
108         call grd2msc(tempgrid,sNx,sNy,igrd,temptile,nchp,nchptot(bi,bj))         call grd2msc(tempgrid,sNx,sNy,igrd(1,bi,bj),
109         .                 temptile,nchp,nchptot(bi,bj))
110         do n = 1,nchp         do n = 1,nchp
111          tcanopy(n,bi,bj) = temptile(n)          tcanopy(n,bi,bj) = temptile(n)
112         enddo         enddo
113    
114         do j = 1,sNx         do j = 1,sNy
115         do i = 1,sNx         do i = 1,sNx
116          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,2)          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,2)
117            if (tempgrid(i,j).gt.1.e14 .and. fracland(i,j,bi,bj).gt.0.0001)
118         .    tempgrid(i,j) = globalarr(i+bislot,j+bjslot,1) - 0.5
119         enddo         enddo
120         enddo         enddo
121         call grd2msc(tempgrid,sNx,sNy,igrd,temptile,nchp,nchptot(bi,bj))         call grd2msc(tempgrid,sNx,sNy,igrd(1,bi,bj),
122         .                    temptile,nchp,nchptot(bi,bj))
123         do n = 1,nchp         do n = 1,nchp
124          tdeep(n,bi,bj) = temptile(n)          tdeep(n,bi,bj) = temptile(n)
125         enddo         enddo
126    
127         do j = 1,sNx         do j = 1,sNy
128         do i = 1,sNx         do i = 1,sNx
129          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,3)          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,3)
130            if (tempgrid(i,j).gt.1.e14 .and. fracland(i,j,bi,bj).gt.0.0001)
131         .    tempgrid(i,j) = 0.01
132         enddo         enddo
133         enddo         enddo
134         call grd2msc(tempgrid,sNx,sNy,igrd,temptile,nchp,nchptot(bi,bj))         call grd2msc(tempgrid,sNx,sNy,igrd(1,bi,bj),
135         .                    temptile,nchp,nchptot(bi,bj))
136         do n = 1,nchp         do n = 1,nchp
137          ecanopy(n,bi,bj) = temptile(n)          ecanopy(n,bi,bj) = temptile(n)
138         enddo         enddo
139    
140         do j = 1,sNx         do j = 1,sNy
141         do i = 1,sNx         do i = 1,sNx
142          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,4)          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,4)
143            if (tempgrid(i,j).gt.1.e14 .and. fracland(i,j,bi,bj).gt.0.0001)
144         .    tempgrid(i,j) = 0.7
145         enddo         enddo
146         enddo         enddo
147         call grd2msc(tempgrid,sNx,sNy,igrd,temptile,nchp,nchptot(bi,bj))         call grd2msc(tempgrid,sNx,sNy,igrd(1,bi,bj),
148         .                    temptile,nchp,nchptot(bi,bj))
149         do n = 1,nchp         do n = 1,nchp
150          swetshal(n,bi,bj) = temptile(n)          swetshal(n,bi,bj) = temptile(n)
151         enddo         enddo
152    
153         do j = 1,sNx         do j = 1,sNy
154         do i = 1,sNx         do i = 1,sNx
155          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,5)          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,5)
156            if (tempgrid(i,j).gt.1.e14 .and. fracland(i,j,bi,bj).gt.0.0001)
157         .    tempgrid(i,j) = 0.5
158         enddo         enddo
159         enddo         enddo
160         call grd2msc(tempgrid,sNx,sNy,igrd,temptile,nchp,nchptot(bi,bj))         call grd2msc(tempgrid,sNx,sNy,igrd(1,bi,bj),
161         .                    temptile,nchp,nchptot(bi,bj))
162         do n = 1,nchp         do n = 1,nchp
163          swetroot(n,bi,bj) = temptile(n)          swetroot(n,bi,bj) = temptile(n)
164         enddo         enddo
165    
166         do j = 1,sNx         do j = 1,sNy
167         do i = 1,sNx         do i = 1,sNx
168          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,6)          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,6)
169            if (tempgrid(i,j).gt.1.e14 .and. fracland(i,j,bi,bj).gt.0.0001)
170         .    tempgrid(i,j) = 0.3
171         enddo         enddo
172         enddo         enddo
173         call grd2msc(tempgrid,sNx,sNy,igrd,temptile,nchp,nchptot(bi,bj))         call grd2msc(tempgrid,sNx,sNy,igrd(1,bi,bj),
174         .                    temptile,nchp,nchptot(bi,bj))
175         do n = 1,nchp         do n = 1,nchp
176          swetdeep(n,bi,bj) = temptile(n)          swetdeep(n,bi,bj) = temptile(n)
177         enddo         enddo
178    
179         do j = 1,sNx         do j = 1,sNy
180         do i = 1,sNx         do i = 1,sNx
181          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,7)          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,7)
182            if (tempgrid(i,j).gt.1.e14 .and. fracland(i,j,bi,bj).gt.0.0001)
183         .    tempgrid(i,j) = 0.
184         enddo         enddo
185         enddo         enddo
186         call grd2msc(tempgrid,sNx,sNy,igrd,temptile,nchp,nchptot(bi,bj))         call grd2msc(tempgrid,sNx,sNy,igrd(1,bi,bj),
187         .                    temptile,nchp,nchptot(bi,bj))
188         do n = 1,nchp         do n = 1,nchp
189          snodep(n,bi,bj) = temptile(n)          snodep(n,bi,bj) = temptile(n)
190         enddo         enddo
191    
192         do j = 1,sNx         do j = 1,sNy
193         do i = 1,sNx         do i = 1,sNx
194          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,8)          tempgrid(i,j) = globalarr(i+bislot,j+bjslot,8)
195            if (tempgrid(i,j).gt.1.e14 .and. fracland(i,j,bi,bj).gt.0.0001)
196         .    tempgrid(i,j) = 0.
197         enddo         enddo
198         enddo         enddo
199         call grd2msc(tempgrid,sNx,sNy,igrd,temptile,nchp,nchptot(bi,bj))         call grd2msc(tempgrid,sNx,sNy,igrd(1,bi,bj),
200         .                    temptile,nchp,nchptot(bi,bj))
201         do n = 1,nchp         do n = 1,nchp
202          capac(n,bi,bj) = temptile(n)          capac(n,bi,bj) = temptile(n)
203         enddo         enddo
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22