File indexing completed on 2018-03-02 18:45:29 UTC
view on githubraw file Latest commit 4fee7a55 on 2004-05-06 02:01:34 UTC
c806179eb4 Alis*0001 program write_float
0002
0003 double precision npart,xpart,ypart,kpart,kfloat,iup,itop
0004 & ,tstart,tend
0005
0006 parameter(Nx=80,Ny=42)
0007 double precision depth(Nx,Ny),xc(Nx),yc(Ny),degX,degY
0008
0009 integer kyear,kpres,kday
0010 real rtime,rlon,rlat
0011 integer narg
0012 logical flag
0013
0014
0015
0016
0017 flag = .true.
0018 narg=iargc()
0019 if ( narg .gt. 0 ) flag = .false.
0020 print*, flag
0021
0022 if (flag) then
0023
0024
0025
0026 ilen2=9*8
0027 open(1,file='float_pos.input',status='new',form='unformatted'
0028 & ,access='direct',recl=ilen2)
0029 endif
0030
0031
0032
0033 ilen=Nx*Ny*8
0034 open(2,file='topog.bump',status='old',form='unformatted'
0035 &, access='direct',recl=ilen)
0036 read(2,rec=1) depth
0037 close(2)
0038
0039
0040
0041 degX=5000.
0042 xc(1)=2500.
0043 do i=2,Nx
0044 xc(i)=xc(i-1)+degX
0045 enddo
0046
0047 degY=5000.
0048 yc(1)=2500.
0049 do j=2,Ny
0050 yc(j)=yc(j-1)+degY
0051 enddo
0052
0053 print*,'xc(1), xc(Nx): ',xc(1), xc(Nx)
0054 print*,'yc(1), yc(Ny): ',yc(1), yc(Ny)
0055
0056
0057 npart = 0.
0058 tstart = -1.
0059 xpart = 0.
0060 ypart = 0.
0061 kpart = 0.
0062 kfloat = 0.
0063 iup = 0.
0064 itop = 0.
0065 tend = -1.
0066 if (flag) write(1,rec=1) npart,tstart,xpart,ypart,
0067 & kpart,kfloat,iup,itop,tend
0068
0069 100 continue
0070
0071 print*, '--------------------------------------------------'
0072 print*, '| FLOAT CONFIGURATION |'
0073 print*, '--------------------------------------------------'
0074 print*, ' '
0075 print*, 'sets over whole basin: '
0076 ip=0
0077
0078
0079
0080
0081
0082 do j=20,30,2
0083 do i=20,50,2
0084 if (depth(i,j) .le. -2530.) then
0085 ip=ip+1
0086 npart = REAL(ip)
0087 tstart = -1.
0088 xpart = xc(i)
0089 ypart = yc(j)
0090 kpart = 5.
0091 kfloat = kpart
0092 iup = 432000.
0093 itop = 43200.
0094 tend = -1.
0095 if (flag) write(1,rec=ip+1) npart,tstart,xpart,ypart,
0096 & kpart,kfloat,iup,itop,tend
0097 endif
0098 enddo
0099 enddo
0100 write(6,200) 'ip = ',ip,' kpart,kfloat,iup,itop,tstart,tend: ',
0101 & kpart,kfloat,iup,itop,tstart,tend
0102 200 format(A,I6,A,2F3.0,4F8.0)
0103
0104 do j=20,30,2
0105 do i=20,50,2
0106 if (depth(i,j) .le. -2530.) then
0107 ip=ip+1
0108 npart = REAL(ip)
0109 tstart = -1.
0110 xpart = xc(i)
0111 ypart = yc(j)
0112 kpart = 5.
0113 kfloat = kpart
0114 iup = 432000.
0115 itop = 86400.
0116 tend = -1.
0117 if (flag) write(1,rec=ip+1) npart,tstart,xpart,ypart,
0118 & kpart,kfloat,iup,itop,tend
0119 endif
0120 enddo
0121 enddo
0122 write(6,200) 'ip = ',ip,' kpart,kfloat,iup,itop,tstart,tend: ',
0123 & kpart,kfloat,iup,itop,tstart,tend
0124
0125
0126
0127
0128
0129
0130
0131 do j=20,30,2
0132 do i=20,50,2
0133 if (depth(i,j) .le. -2530.) then
0134 ip=ip+1
0135 npart = REAL(ip)
0136 tstart = 172800.
0137 xpart = xc(i)
0138 ypart = yc(j)
0139 kpart = 0.
0140 kfloat = 5.
0141 iup = 86400.
0142 itop = 43200.
0143 tend = 518400.
0144 if (flag) write(1,rec=ip+1) npart,tstart,xpart,ypart,
0145 & kpart,kfloat,iup,itop,tend
0146 endif
0147 enddo
0148 enddo
0149 write(6,200) 'ip = ',ip,' kpart,kfloat,iup,itop,tstart,tend: ',
0150 & kpart,kfloat,iup,itop,tstart,tend
0151
0152
0153
0154
0155
0156
0157 do j=20,30,2
0158 do i=20,50,2
0159 if (depth(i,j) .le. -2530.) then
0160 ip=ip+1
0161 npart = REAL(ip)
0162 tstart = 432000.
0163 xpart = xc(i)
0164 ypart = yc(j)
0165 kpart = 0.
0166 kfloat = 5.
0167 iup = 0.
0168 itop = 0.
0169 tend = -1.
0170 if (flag) write(1,rec=ip+1) npart,tstart,xpart,ypart,
0171 & kpart,kfloat,iup,itop,tend
0172 endif
0173 enddo
0174 enddo
0175 write(6,200) 'ip = ',ip,' kpart,kfloat,iup,itop,tstart,tend: ',
0176 & kpart,kfloat,iup,itop,tstart,tend
0177
0178
0179
0180 do j=20,30,2
0181 i=20
0182 ip=ip+1
0183 npart = REAL(ip)
0184 tstart = -1.
0185 xpart = xc(i)
0186 ypart = yc(j)
0187 kpart = 0.
0188 kfloat = kpart
0189 iup = -3.
0190 itop = 0.
0191 tend = -1.
0192 if (flag) write(1,rec=ip+1) npart,tstart,xpart,ypart,
0193 & kpart,kfloat,iup,itop,tend
0194 enddo
0195 write(6,200) 'ip = ',ip,' kpart,kfloat,iup,itop,tstart,tend: ',
0196 & kpart,kfloat,iup,itop,tstart,tend
0197
0198
0199 print*, ' '
0200 print*, '--------------------------------------------------'
0201 print*, 'total number of floats: npart = ',ip
0202 print*, '--------------------------------------------------'
0203
0204
0205 npart = DBLE(ip)
0206 tstart = -1.
0207 xpart = 0.
0208 ypart = 0.
0209 kpart = 0.
0210 kfloat = DBLE(ip)
0211 iup = 0.
0212 itop = 0.
0213 tend = -1.
0214 if (flag)
0215 & write(1,rec=1) npart,tstart,xpart,ypart,kpart,kfloat,iup,itop,tend
0216
0217
0218
0219 close(1)
0220
0221 end