flt_example/extra/write_float.F

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 c
                0009         integer kyear,kpres,kday
                0010         real rtime,rlon,rlat
                0011         integer narg
                0012         logical flag
                0013
                0014 c
                0015 c if float should not be written use flag
                0016 c
                0017       flag = .true.
                0018       narg=iargc()
                0019       if ( narg .gt. 0 ) flag = .false.
                0020       print*, flag
                0021
                0022       if (flag) then
                0023 c
                0024 c open float file
                0025 c
                0026         ilen2=9*8
                0027         open(1,file='float_pos.input',status='new',form='unformatted'
                0028      &       ,access='direct',recl=ilen2)
                0029       endif
                0030 c
                0031 c read bathymetry
                0032 c
                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 c
                0039 c generate axes
                0040 c
                0041         degX=5000.
                0042         xc(1)=2500.
                0043         do i=2,Nx
                0044            xc(i)=xc(i-1)+degX
                0045         enddo
                0046 c
                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 c
                0056 c preset first line with dummies
                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 c
                0071         print*, '--------------------------------------------------'
                0072         print*, '|         FLOAT CONFIGURATION                    |'
                0073         print*, '--------------------------------------------------'
                0074         print*, ' '
                0075         print*, 'sets over whole basin: '
                0076         ip=0
                0077 c
                0078 c target depth: level 5
                0079 c profiling:    5 days
                0080 c surface time: 12, 24  hours
                0081 c
                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 c
                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 c
                0125 c
                0126 c target depth: level 5
                0127 c profiling:    1 day
                0128 c surface time: 12 hours
                0129 c integrating only day 2-5
                0130 c
                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 c
                0152 c
                0153 c target depth: level 5
                0154 c no profiling
                0155 c integrating starting day 5
                0156 c
                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 c
                0178 c mooring
                0179 c
                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 c
                0198
                0199         print*, ' '
                0200         print*, '--------------------------------------------------'
                0201         print*, 'total number of floats: npart = ',ip
                0202         print*, '--------------------------------------------------'
                0203
                0204 c write total number of floats in first line
                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