/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_interp_vert.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagnostics_interp_vert.F

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

revision 1.11 by jmc, Sun Jan 10 04:09:31 2010 UTC revision 1.12 by jmc, Sun Jun 12 19:16:09 2011 UTC
# Line 11  C     !INTERFACE: Line 11  C     !INTERFACE:
11        SUBROUTINE DIAGNOSTICS_INTERP_VERT(        SUBROUTINE DIAGNOSTICS_INTERP_VERT(
12       I                        listId, md, ndId, ip, im, lm,       I                        listId, md, ndId, ip, im, lm,
13       U                        qtmp1,       U                        qtmp1,
14       I                        undef,       O                        qtmp2,
15         I                        undefRL,
16       I                        myTime, myIter, myThid )       I                        myTime, myIter, myThid )
17    
18  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 41  C     ip      :: diagnostics  pointer to Line 42  C     ip      :: diagnostics  pointer to
42  C     im      :: counter-mate pointer to storage array  C     im      :: counter-mate pointer to storage array
43  C     lm      :: index in the averageCycle  C     lm      :: index in the averageCycle
44  C     qtmp1   :: diagnostics field output array  C     qtmp1   :: diagnostics field output array
45  C     undef   ::  C     qtmp2   :: temp working array (same size as output array)
46    C     undefRL ::
47  C     myTime  :: current time of simulation (s)  C     myTime  :: current time of simulation (s)
48  C     myIter  :: current iteration number  C     myIter  :: current iteration number
49  C     myThid  :: my Thread Id number  C     myThid  :: my Thread Id number
50        INTEGER listId, md, ndId, ip, im, lm        INTEGER listId, md, ndId, ip, im, lm
51        _RL     qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)        _RL     qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
52        _RL     undef        _RL     qtmp2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
53          _RL     undefRL
54        _RL     myTime        _RL     myTime
55        INTEGER myIter, myThid        INTEGER myIter, myThid
56  CEOP  CEOP
# Line 63  C     i,j,k :: loop indices Line 66  C     i,j,k :: loop indices
66        INTEGER i, j, k        INTEGER i, j, k
67        INTEGER bi, bj        INTEGER bi, bj
68        _RL   qtmpsrf(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RL   qtmpsrf(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
       _RL   qtmp2  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)  
69        INTEGER kLev        INTEGER kLev
70        _RL   qprs (sNx,sNy)        _RL   qprs (sNx,sNy)
71        _RL   qinp (sNx,sNy,NrMax)        _RL   qinp (sNx,sNy,NrMax)
72        _RL   pkz  (sNx,sNy,NrMax)        _RL   pkz  (sNx,sNy,NrMax)
73        _RL   pksrf(sNx,sNy)        _RL   pksrf(sNx,sNy)
74        _RL   pk, pkTop, tmpLev        _RL   pk, pkTop
75        _RL   kappa        _RL   kappa
76        INTEGER jpoint1,ipoint1        INTEGER jpoint1, ipoint1
77        INTEGER jpoint2,ipoint2        INTEGER jpoint2, ipoint2
78        LOGICAL pInc        LOGICAL pInc
79        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
80    
# Line 110  C-    averageCycle: move pointer Line 112  C-    averageCycle: move pointer
112    
113            DO bj = myByLo(myThid), myByHi(myThid)            DO bj = myByLo(myThid), myByHi(myThid)
114             DO bi = myBxLo(myThid), myBxHi(myThid)             DO bi = myBxLo(myThid), myBxHi(myThid)
115               tmpLev = 1. _d 0               CALL DIAGNOSTICS_GET_DIAG( 1, undefRL,
              CALL GETDIAG( tmpLev,undef,  
116       O                     qtmpsrf(1-OLx,1-OLy,bi,bj),       O                     qtmpsrf(1-OLx,1-OLy,bi,bj),
117       I                     jpoint1,0,ipoint1,0, bi,bj,myThid )       I                     jpoint1,0,ipoint1,0, bi,bj,myThid )
118  c            WRITE(0,*) 'rSurf:',bi,bj,qtmpsrf(15,15,bi,bj)  c            WRITE(0,*) 'rSurf:',bi,bj,qtmpsrf(15,15,bi,bj)
119               DO k = 1,kdiag(jpoint2)               CALL DIAGNOSTICS_GET_DIAG( 0, undefRL,
120                tmpLev = k       O                     qtmp2(1-OLx,1-OLy,1,bi,bj),
               CALL GETDIAG(tmpLev,undef,  
      O                     qtmp2(1-OLx,1-OLy,k,bi,bj),  
121       I                     jpoint2,0,ipoint2,0, bi,bj,myThid )       I                     jpoint2,0,ipoint2,0, bi,bj,myThid )
              ENDDO  
122             ENDDO             ENDDO
123            ENDDO            ENDDO
124    
# Line 177  c            kLev = k Line 175  c            kLev = k
175                  IF (maskC(i,j,kLev,bi,bj).NE.0.) THEN                  IF (maskC(i,j,kLev,bi,bj).NE.0.) THEN
176                   qinp(i,j,k)= qtmp1(i,j,kLev,bi,bj)                   qinp(i,j,k)= qtmp1(i,j,kLev,bi,bj)
177                  ELSE                  ELSE
178                   qinp(i,j,k)= undef                   qinp(i,j,k)= undefRL
179                  ENDIF                  ENDIF
180                  pkz(i,j,k)  = qtmp2(i,j,kLev,bi,bj)**kappa                  pkz(i,j,k)  = qtmp2(i,j,kLev,bi,bj)**kappa
181                ENDDO                ENDDO
# Line 191  C-    Interpolate, level per level, and Line 189  C-    Interpolate, level per level, and
189               CALL DIAGNOSTICS_INTERP_P2P(               CALL DIAGNOSTICS_INTERP_P2P(
190       O                        qprs,       O                        qprs,
191       I                        qinp,pkz,pksrf,pkTop,pk,       I                        qinp,pkz,pksrf,pkTop,pk,
192       I                        undef,pInc,sNx*sNy,kdiag(ndId),myThid )       I                        undefRL,pInc,sNx*sNy,kdiag(ndId),myThid )
193  C-    Transfert qprs to qtmp1:  C-    Transfert qprs to qtmp1:
194               DO j = 1,sNy               DO j = 1,sNy
195                DO i = 1,sNx                DO i = 1,sNx
196                 IF (qprs(i,j).EQ.undef) THEN                 IF (qprs(i,j).EQ.undefRL) THEN
197                   qtmp1(i,j,k,bi,bj) = 0.                   qtmp1(i,j,k,bi,bj) = 0.
198                 ELSE                 ELSE
199                   qtmp1(i,j,k,bi,bj) =  qprs(i,j)                   qtmp1(i,j,k,bi,bj) =  qprs(i,j)
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22