/[MITgcm]/MITgcm/pkg/flt/flt_traj.F
ViewVC logotype

Diff of /MITgcm/pkg/flt/flt_traj.F

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

revision 1.1 by adcroft, Thu Sep 13 17:43:56 2001 UTC revision 1.2 by jmc, Wed Dec 3 01:37:45 2008 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "FLT_CPPOPTIONS.h"  #include "FLT_OPTIONS.h"
5    
6    
7        subroutine flt_traj (        SUBROUTINE FLT_TRAJ (
8       I                     myCurrentIter,       I                     myIter,
9       I                     myCurrentTime,       I                     myTime,
10       I                     myThid       I                     myThid
11       &                     )       &                     )
12    
13  c     ==================================================================  C     ==================================================================
14  c     SUBROUTINE flt_traj  C     SUBROUTINE FLT_TRAJ
15  c     ==================================================================  C     ==================================================================
16  c  C
17  c     o This routine samples the model state at float position every  C     o This routine samples the model state at float position every
18  c       flt_int_traj time steps and writes output.  C       flt_int_traj time steps and writes output.
19  c  C
20  c     ==================================================================  C     ==================================================================
21  c     SUBROUTINE flt_traj  C     SUBROUTINE FLT_TRAJ
22  c     ==================================================================  C     ==================================================================
23    
24  c     == global variables ==  C     == global variables ==
25    
 #include "EEPARAMS.h"  
26  #include "SIZE.h"  #include "SIZE.h"
27  #include "DYNVARS.h"  #include "EEPARAMS.h"
28  #include "PARAMS.h"  #include "PARAMS.h"
 #include "SOLVE_FOR_PRESSURE.h"  
29  #include "GRID.h"  #include "GRID.h"
30    #include "DYNVARS.h"
31    #include "SOLVE_FOR_PRESSURE.h"
32  #include "FLT.h"  #include "FLT.h"
33  c#include "UNITS.h"  c#include "UNITS.h"
34    
35  c     == routine arguments ==  C     == routine arguments ==
36    
37        INTEGER myCurrentIter, myThid        INTEGER myIter, myThid
38        _RL myCurrentTime        _RL myTime
39        INTEGER bi, bj, imax        INTEGER bi, bj, imax
40        parameter (imax=10)        PARAMETER (imax=10)
41    
42  c     == local variables ==  C     == local variables ==
43    
44        integer ip, kp, iip        INTEGER ip, kp, ii
45        _RL xx, yy, xlo, xhi, ylo, yhi        _RL xx, yy, xlo, xhi, ylo, yhi
46        _RL uu,vv,ww,tt,ss, pp        _RL uu,vv,ww,tt,ss, pp
47        _RL global2local_i        _RL global2local_i
48        _RL global2local_j        _RL global2local_j
 c  
       integer irecord  
       _RL tmp(imax)  
49    
50          INTEGER irecord
51          _RL tmp(imax)
52        _RL npart_read,npart_times        _RL npart_read,npart_times
   
53        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
54        character*(max_len_mbuf) msgbuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
55    
56  C Functions  C Functions
57        integer ILNBLNK        INTEGER ILNBLNK
58  C Local variables  C Local variables
59        character*(80) dataFName        CHARACTER*(80) dataFName
60        integer iG,jG,IL        INTEGER iG,jG,IL
61        logical exst        LOGICAL exst
62        logical globalFile        LOGICAL globalFile
63    
64  c     == end of interface ==  C     == end of interface ==
65    
66        fn = 'float_trajectories'        fn = 'float_trajectories'
67    
# Line 71  c     == end of interface == Line 69  c     == end of interface ==
69        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
70        DO bi=myBxLo(myThid),myBxHi(myThid)        DO bi=myBxLo(myThid),myBxHi(myThid)
71    
72  c  C (1) read actual number floats from file (if exists)
 c (1) read actual number floats from file (if exists)  
73           IL=ILNBLNK( fn )           IL=ILNBLNK( fn )
74           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
75           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
76           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           WRITE(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
77       &              fn(1:IL),'.',iG,'.',jG,'.data'       &              fn(1:IL),'.',iG,'.',jG,'.data'
78           inquire( file=dataFname, exist=exst )           INQUIRE( file=dataFname, exist=exst )
79           if (exst) then           IF (exst) THEN
80              call mdsreadvector_flt(fn,globalFile,64,'RL',              CALL FLT_MDSREADVECTOR(fn,globalFile,64,'RL',
81       &                             imax,tmp,bi,bj,1,mythid)       &                             imax,tmp,bi,bj,1,myThid)
82              npart_read  = tmp(1)              npart_read  = tmp(1)
83              npart_times = tmp(5)              npart_times = tmp(5)
84           else           ELSE
85              npart_read  = 0.              npart_read  = 0.
86              npart_times = 0.              npart_times = 0.
87              tmp(2)      = myCurrentTime              tmp(2)      = myTime
88           endif           ENDIF
89    
90  c  C the standard routine mdswritevector can be used here
91  c the standard routine mdswritevector can be used here  C (2) WRITE new actual number floats and time axis into file
92  c (2) write new actual number floats and time axis into file  C
93  c  C total number of records in this file
 c total number of records in this file  
94           tmp(1) = DBLE(npart_tile(bi,bj))+npart_read           tmp(1) = DBLE(npart_tile(bi,bj))+npart_read
95  c first time of writing floats (do not change when written)  C first time of writing floats (do not change when written)
96  c        tmp(2) = tmp(2)  c        tmp(2) = tmp(2)
97  c current time  C current time
98           tmp(3) = myCurrentTime           tmp(3) = myTime
99  c timestep  C timestep
100           tmp(4) = flt_int_traj           tmp(4) = flt_int_traj
101  c total number of timesteps  C total number of timesteps
102           tmp(5) = npart_times + 1.           tmp(5) = npart_times + 1.
103  c total number of floats  C total number of floats
104           tmp(6) = max_npart           tmp(6) = max_npart
105           do ip=7,imax           DO ip=7,imax
106              tmp(ip) = 0.              tmp(ip) = 0.
107           enddo           ENDDO
108    
109           call mdswritevector(fn,64,.false.,'RL',imax,tmp,bi,bj,1,           CALL MDSWRITEVECTOR(fn,64,.false.,'RL',imax,tmp,bi,bj,1,
110       &                     myCurrentIter,mythid)       &                       myIter,myThid)
111    
112           do ip=1,npart_tile(bi,bj)           DO ip=1,npart_tile(bi,bj)
113    
114              xx=global2local_i(xpart(ip,bi,bj),bi,bj,mythid)              xx=global2local_i(xpart(ip,bi,bj),bi,bj,myThid)
115              yy=global2local_j(ypart(ip,bi,bj),bi,bj,mythid)              yy=global2local_j(ypart(ip,bi,bj),bi,bj,myThid)
116              kp=INT(kpart(ip,bi,bj))              kp =  INT(kpart(ip,bi,bj))
117              tmp(1)  = npart(ip,bi,bj)              tmp(1)  = npart(ip,bi,bj)
118              tmp(2)  = myCurrentTime              tmp(2)  = myTime
119              tmp(3)  = xpart(ip,bi,bj)                tmp(3)  = xpart(ip,bi,bj)
120              tmp(4)  = ypart(ip,bi,bj)              tmp(4)  = ypart(ip,bi,bj)
121              tmp(5)  = kpart(ip,bi,bj)              tmp(5)  = kpart(ip,bi,bj)
122    
123           if(              IF (
124       &  (                             myCurrentTime.ge.tstart(ip,bi,bj))       &           ( myTime.GE.tstart(ip,bi,bj))
125       &   .and.       &       .AND.
126       &  (  tend(ip,bi,bj).eq.-1. .or. myCurrentTime.le.  tend(ip,bi,bj))       &           ( tend(ip,bi,bj).EQ.-1. .OR. myTime.LE.tend(ip,bi,bj))
127       &      ) then       &         ) THEN
128    
129  c            if(tstart(ip,bi,bj) .ne. -1.              .and.  c           if (tstart(ip,bi,bj) .NE. -1.              .AND.
130  c     &         myCurrentTime    .ge. tstart(ip,bi,bj) .and.  c     &         myTime    .GE. tstart(ip,bi,bj) .AND.
131  c     &         myCurrentTime    .le.   tend(ip,bi,bj)) then  c     &         myTime    .LE.   tend(ip,bi,bj)) THEN
132    
133                 call flt_bilinear  (xx,yy,uu,kp,uVel,  2,bi,bj)                IF ( kp.LT.1 .OR. kp.GT.Nr ) THEN
134                 call flt_bilinear  (xx,yy,vv,kp,vVel,  3,bi,bj)                  WRITE(msgBuf,'(2A,I8)') '** WARNING ** FLT_TRAJ: ',
135                 call flt_bilinear2d(xx,yy,pp,   cg2d_x,1,bi,bj)       &            ' illegal value for kp=',kp
136                 call flt_bilinear  (xx,yy,tt,kp,theta, 1,bi,bj)                  CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
137                 call flt_bilinear  (xx,yy,ss,kp,salt,  1,bi,bj)       &                              SQUEEZE_RIGHT, myThid )
138                    WRITE(msgBuf,'(A,1P5E20.13)')
139                 tmp(6)   = uu       &            ' FLT_TRAJ: ', (tmp(ii),ii=1,5)
140                 tmp(7)   = vv                  CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
141                 tmp(8)   = tt       &                              SQUEEZE_RIGHT, myThid )
142                 tmp(9)   = ss  c               CALL PRINT_ERROR( msgBuf, myThid )
143                 tmp(10)  = pp  c               STOP 'ABNORMAL END: S/R FLT_TRAJ'
144               else                ENDIF
145                 tmp(6)   = flt_nan  C-- jmc: not sure if this is right but added to avoid Pb in FLT_BILINEAR:
146                 tmp(7)   = flt_nan                kp = MIN( MAX(kp,1), Nr)
147                 tmp(8)   = flt_nan  
148                 tmp(9)   = flt_nan                CALL FLT_BILINEAR  (xx,yy,uu,kp,uVel,  2,bi,bj)
149               endif                CALL FLT_BILINEAR  (xx,yy,vv,kp,vVel,  3,bi,bj)
150                  CALL FLT_BILINEAR2D(xx,yy,pp,   cg2d_x,1,bi,bj)
151  c                CALL FLT_BILINEAR  (xx,yy,tt,kp,theta, 1,bi,bj)
152  c the standard routine mdswritevector can be used here                CALL FLT_BILINEAR  (xx,yy,ss,kp,salt,  1,bi,bj)
153  c (3) write float positions into file  
154                  tmp(6)   = uu
155                  tmp(7)   = vv
156                  tmp(8)   = tt
157                  tmp(9)   = ss
158                  tmp(10)  = pp
159                ELSE
160                  tmp(6)   = flt_nan
161                  tmp(7)   = flt_nan
162                  tmp(8)   = flt_nan
163                  tmp(9)   = flt_nan
164                  tmp(10)  = flt_nan
165                ENDIF
166    
167    C the standard routine mdswritevector can be used here
168    C (3) WRITE float positions into file
169    
170              irecord=npart_read+ip+1              irecord=npart_read+ip+1
171              call mdswritevector(fn,64,.false.,'RL',imax,tmp,bi,bj,              CALL MDSWRITEVECTOR(fn,64,.false.,'RL',imax,tmp,bi,bj,
172       &                        irecord,myCurrentIter,mythid)       &                          irecord,myIter,myThid)
173    
174           enddo           ENDDO
175    
176         ENDDO         ENDDO
177         ENDDO         ENDDO
178    
179        return        RETURN
180        end        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22