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

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

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

revision 1.21 by jmc, Mon Jul 11 18:59:07 2005 UTC revision 1.24 by molod, Tue Aug 16 21:29:38 2005 UTC
# Line 20  C     !USES: Line 20  C     !USES:
20  C     == Global variables ===  C     == Global variables ===
21  #include "SIZE.h"  #include "SIZE.h"
22  #include "EEPARAMS.h"  #include "EEPARAMS.h"
23    #include "PARAMS.h"
24  #include "GRID.h"  #include "GRID.h"
25  #include "DYNVARS.h"  #include "DYNVARS.h"
26  #include "SURFACE.h"  #include "SURFACE.h"
# Line 42  C     == Local variables == Line 43  C     == Local variables ==
43        _RL tmpMk(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL tmpMk(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
44        _RL tmpMk1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+1,nSx,nSy)        _RL tmpMk1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+1,nSx,nSy)
45        _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
46        _RL tmpFac        _RL tmpFac, uBarC, vBarC
47          _RL dummy1, dummy2, dummy3, dummy4, kappa, getcon
48        INTEGER i,j,K,bi,bj        INTEGER i,j,K,bi,bj
49        INTEGER km1        INTEGER km1
50                
# Line 52  C     == Local variables == Line 54  C     == Local variables ==
54  C--   fill momentum state-var diagnostics:  C--   fill momentum state-var diagnostics:
55    
56          CALL DIAGNOSTICS_FILL(etaN, 'ETAN    ',0, 1,0,1,1,myThid)          CALL DIAGNOSTICS_FILL(etaN, 'ETAN    ',0, 1,0,1,1,myThid)
57    
58            IF ( DIAGNOSTICS_IS_ON('RSURF   ',myThid) ) THEN
59             DO bj = myByLo(myThid), myByHi(myThid)
60              DO bi = myBxLo(myThid), myBxHi(myThid)
61               DO j = 1,sNy
62                DO i = 1,sNx
63                  tmp1k(i,j,bi,bj) = Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj)
64                ENDDO
65               ENDDO
66              ENDDO
67             ENDDO
68             CALL DIAGNOSTICS_FILL(tmp1k,'RSURF   ',0,1,0,1,1,myThid)
69            ENDIF
70    
71          CALL DIAGNOSTICS_SCALE_FILL(etaN,tmpFac,2,          CALL DIAGNOSTICS_SCALE_FILL(etaN,tmpFac,2,
72       &                              'ETANSQ  ',0, 1,0,1,1,myThid)       &                              'ETANSQ  ',0, 1,0,1,1,myThid)
73                
# Line 105  C---+----1----+----2----+----3----+----4 Line 121  C---+----1----+----2----+----3----+----4
121             DO K=1,Nr             DO K=1,Nr
122              DO j = 1,sNy              DO j = 1,sNy
123               DO i = 1,sNx               DO i = 1,sNx
124                tmpMk(i,j,K,bi,bj) = 0.25 _d 0                uBarC = 0.5 _d 0
125       &           *(uVel(i,j,K,bi,bj)+uVel(i+1,j,K,bi,bj))       &           *(uVel(i,j,K,bi,bj)+uVel(i+1,j,K,bi,bj))
126                  vBarC = 0.5 _d 0
127       &           *(vVel(i,j,K,bi,bj)+vVel(i,j+1,K,bi,bj))       &           *(vVel(i,j,K,bi,bj)+vVel(i,j+1,K,bi,bj))
128                  tmpMk(i,j,K,bi,bj) =
129         &            ( angleCosC(i,j,bi,bj)*uBarC
130         &             -angleSinC(i,j,bi,bj)*vBarC )
131         &           *( angleSinC(i,j,bi,bj)*uBarC
132         &             +angleCosC(i,j,bi,bj)*vBarC )
133               ENDDO               ENDDO
134              ENDDO              ENDDO
135             ENDDO             ENDDO
# Line 318  C--   fill tracer state-var diagnostics: Line 340  C--   fill tracer state-var diagnostics:
340          CALL DIAGNOSTICS_FILL(theta,'THETA   ',0,Nr,0,1,1,myThid)          CALL DIAGNOSTICS_FILL(theta,'THETA   ',0,Nr,0,1,1,myThid)
341          CALL DIAGNOSTICS_FILL(salt, 'SALT    ',0,Nr,0,1,1,myThid)          CALL DIAGNOSTICS_FILL(salt, 'SALT    ',0,Nr,0,1,1,myThid)
342    
343    #ifdef ALLOW_FIZHI
344          IF((useFIZHI).and.(DIAGNOSTICS_IS_ON('RELHUM  ',myThid)))THEN
345           kappa = getcon('KAPPA')
346           do bj = myByLo(myThid), myByHi(myThid)
347           do bi = myBxLo(myThid), myBxHi(myThid)
348            do j = 1,sNy
349             do i = 1,sNx
350              do K = 1,Nr
351               dummy1 = theta(i,j,k,bi,bj) * ((rc(k)/100.)/1000.)**kappa
352               dummy2 = rc(k) / 100.
353               call qsat(dummy1,dummy2,dummy3,dummy4,.false.)
354               tmpMk(i,j,K,bi,bj) = hfacC(i,j,K,bi,bj) *
355         .                    salt(i,j,k,bi,bj) * 100. / dummy3
356               if(k.lt.4) print *,' Temp ',dummy1,' Pres ',dummy2,' q ',
357         .      salt(i,j,k,bi,bj),' qstar ',dummy3,' rh ',tmpMk(i,j,K,bi,bj)
358              enddo
359             enddo
360            enddo
361           enddo
362           enddo
363           CALL DIAGNOSTICS_FILL(tmpMk, 'RELHUM  ',0,Nr,0,1,1,myThid)
364          ENDIF
365    #endif /* ALLOW_FIZHI */
366    
367          CALL DIAGNOSTICS_SCALE_FILL(theta,tmpFac,2,          CALL DIAGNOSTICS_SCALE_FILL(theta,tmpFac,2,
368       &                              'THETASQ ',0,Nr,0,1,1,myThid)       &                              'THETASQ ',0,Nr,0,1,1,myThid)
369          CALL DIAGNOSTICS_SCALE_FILL(salt,tmpFac,2,          CALL DIAGNOSTICS_SCALE_FILL(salt,tmpFac,2,
Legend:
Removed from v.1.21  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22