model/src/diags_oceanic_surf_flux.F

C $Header: /u/gcmpack/MITgcm/model/src/diags_oceanic_surf_flux.F,v 1.1 2005/07/11 22:31:21 jmc Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: DIAGS_OCEANIC_SURF_FLUX
C     !INTERFACE:
      SUBROUTINE DIAGS_OCEANIC_SURF_FLUX( myTime, myIter, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE DIAGS_OCEANIC_SURF_FLUX
C     | o Compute Diagnostics of Surface Fluxes (ocean only)
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE

C     == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "SURFACE.h"
#include "FFIELDS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     myTime :: Current time in simulation
C     myIter :: Current iteration number in simulation
C     myThid :: Thread number for this instance of the routine.
      _RL myTime
      INTEGER myIter
      INTEGER myThid 
CEOP

#ifdef ALLOW_DIAGNOSTICS
C     !LOCAL VARIABLES:
C     i,j,bi,bj :: loop indices
C     ks        :: surface level index
      LOGICAL  DIAGNOSTICS_IS_ON
      EXTERNAL DIAGNOSTICS_IS_ON
      INTEGER i,j,bi,bj
      INTEGER ks
      _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      _RL tmpFac

C-    Time Averages of surface fluxes
       IF ( usingPCoords ) THEN
        ks=Nr
       ELSE
        ks=1
       ENDIF

C-    taux (surface momentum flux [Pa=N/m2], positive <-> increase u)
       CALL DIAGNOSTICS_SCALE_FILL(fu,foFacMom,1,
     &                             'TAUX    ',0, 1,0,1,1,myThid)

C-    tauy (surface momentum flux [Pa=N/m2], positive <-> increase v)
       CALL DIAGNOSTICS_SCALE_FILL(fv,foFacMom,1,
     &                             'TAUY    ',0, 1,0,1,1,myThid)

C     tFlux (=Heat flux [W/m2], positive <-> increasing Theta)
      IF ( DIAGNOSTICS_IS_ON('TFLUX   ',myThid) ) THEN
       DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)
         DO j = 1,sNy
          DO i = 1,sNx
           tmp1k(i,j,bi,bj) =
#ifdef SHORTWAVE_HEATING
     &      -Qsw(i,j,bi,bj)+
#endif
     &      (surfaceForcingT(i,j,bi,bj)+surfaceForcingTice(I,J,bi,bj))
     &      *HeatCapacity_Cp*recip_horiVertRatio*rhoConst
          ENDDO
         ENDDO
#ifdef NONLIN_FRSURF
         IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
     &        .AND. useRealFreshWaterFlux ) THEN
          DO j=1,sNy
           DO i=1,sNx
            tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj)
     &       + PmEpR(i,j,bi,bj)*rhoConstFresh
     &                         *theta(i,j,ks,bi,bj)*HeatCapacity_Cp
           ENDDO
          ENDDO
         ENDIF
#endif /* NONLIN_FRSURF */
        ENDDO
       ENDDO
       CALL DIAGNOSTICS_FILL(tmp1k,'TFLUX   ',0,1,0,1,1,myThid)
      ENDIF

#ifdef SHORTWAVE_HEATING
C-    swflux
      IF ( DIAGNOSTICS_IS_ON('SWFLUX  ',myThid) ) THEN
       DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)
         DO j = 1,sNy
          DO i = 1,sNx
           tmp1k(i,j,bi,bj) = -Qsw(i,j,bi,bj)
          ENDDO
         ENDDO
        ENDDO
       ENDDO
       CALL DIAGNOSTICS_FILL(tmp1k,'SWFLUX  ',0,1,0,1,1,myThid)
      ENDIF
#endif

C     tIce (=Heat flux [W/m2] from melt/freeze of sea-ice, positive <-> increasing Theta)
       tmpFac = HeatCapacity_Cp*recip_horiVertRatio*rhoConst
       CALL DIAGNOSTICS_SCALE_FILL(surfaceForcingTice,tmpFac,1,
     &                             'TICE    ',0, 1,0,1,1,myThid)

C     sFlux (=salt flux [g/m2/s], positive <-> increasing Salt)
      IF ( DIAGNOSTICS_IS_ON('SFLUX   ',myThid) ) THEN
       DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)
         DO j = 1,sNy
          DO i = 1,sNx
           tmp1k(i,j,bi,bj) =
     &      surfaceForcingS(i,j,bi,bj)*
     &      recip_horiVertRatio*rhoConst
          ENDDO
         ENDDO
#ifdef NONLIN_FRSURF
         IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
     &        .AND. useRealFreshWaterFlux ) THEN
          DO j=1,sNy
           DO i=1,sNx
            tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj)
     &       + PmEpR(i,j,bi,bj)*rhoConstFresh
     &                        *salt(i,j,ks,bi,bj)
           ENDDO
          ENDDO
         ENDIF
#endif /* NONLIN_FRSURF */
        ENDDO
       ENDDO
       CALL DIAGNOSTICS_FILL(tmp1k,'SFLUX   ',0,1,0,1,1,myThid)
      ENDIF
#endif /* ALLOW_DIAGNOSTICS */

      RETURN 
      END
1	C $Header: /u/gcmpack/MITgcm/model/src/diags_oceanic_surf_flux.F,v 1.1 2005/07/11 22:31:21 jmc Exp $
2	C $Name: $
3
4	#include "PACKAGES_CONFIG.h"
5	#include "CPP_OPTIONS.h"
6
7	CBOP
8	C !ROUTINE: DIAGS_OCEANIC_SURF_FLUX
9	C !INTERFACE:
10	SUBROUTINE DIAGS_OCEANIC_SURF_FLUX( myTime, myIter, myThid )
11
12	C !DESCRIPTION: \bv
13	C ==========================================================
14	C \| SUBROUTINE DIAGS_OCEANIC_SURF_FLUX
15	C \| o Compute Diagnostics of Surface Fluxes (ocean only)
16	C ==========================================================
17	C \ev
18
19	C !USES:
20	IMPLICIT NONE
21
22	C == Global variables ===
23	#include "SIZE.h"
24	#include "EEPARAMS.h"
25	#include "PARAMS.h"
26	#include "GRID.h"
27	#include "DYNVARS.h"
28	#include "SURFACE.h"
29	#include "FFIELDS.h"
30
31	C !INPUT/OUTPUT PARAMETERS:
32	C == Routine arguments ==
33	C myTime :: Current time in simulation
34	C myIter :: Current iteration number in simulation
35	C myThid :: Thread number for this instance of the routine.
36	_RL myTime
37	INTEGER myIter
38	INTEGER myThid
39	CEOP
40
41	#ifdef ALLOW_DIAGNOSTICS
42	C !LOCAL VARIABLES:
43	C i,j,bi,bj :: loop indices
44	C ks :: surface level index
45	LOGICAL DIAGNOSTICS_IS_ON
46	EXTERNAL DIAGNOSTICS_IS_ON
47	INTEGER i,j,bi,bj
48	INTEGER ks
49	_RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
50	_RL tmpFac
51
52	C- Time Averages of surface fluxes
53	IF ( usingPCoords ) THEN
54	ks=Nr
55	ELSE
56	ks=1
57	ENDIF
58
59	C- taux (surface momentum flux [Pa=N/m2], positive <-> increase u)
60	CALL DIAGNOSTICS_SCALE_FILL(fu,foFacMom,1,
61	& 'TAUX ',0, 1,0,1,1,myThid)
62
63	C- tauy (surface momentum flux [Pa=N/m2], positive <-> increase v)
64	CALL DIAGNOSTICS_SCALE_FILL(fv,foFacMom,1,
65	& 'TAUY ',0, 1,0,1,1,myThid)
66
67	C tFlux (=Heat flux [W/m2], positive <-> increasing Theta)
68	IF ( DIAGNOSTICS_IS_ON('TFLUX ',myThid) ) THEN
69	DO bj = myByLo(myThid), myByHi(myThid)
70	DO bi = myBxLo(myThid), myBxHi(myThid)
71	DO j = 1,sNy
72	DO i = 1,sNx
73	tmp1k(i,j,bi,bj) =
74	#ifdef SHORTWAVE_HEATING
75	& -Qsw(i,j,bi,bj)+
76	#endif
77	& (surfaceForcingT(i,j,bi,bj)+surfaceForcingTice(I,J,bi,bj))
78	& HeatCapacity_Cprecip_horiVertRatio*rhoConst
79	ENDDO
80	ENDDO
81	#ifdef NONLIN_FRSURF
82	IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
83	& .AND. useRealFreshWaterFlux ) THEN
84	DO j=1,sNy
85	DO i=1,sNx
86	tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj)
87	& + PmEpR(i,j,bi,bj)*rhoConstFresh
88	& theta(i,j,ks,bi,bj)HeatCapacity_Cp
89	ENDDO
90	ENDDO
91	ENDIF
92	#endif /* NONLIN_FRSURF */
93	ENDDO
94	ENDDO
95	CALL DIAGNOSTICS_FILL(tmp1k,'TFLUX ',0,1,0,1,1,myThid)
96	ENDIF
97
98	#ifdef SHORTWAVE_HEATING
99	C- swflux
100	IF ( DIAGNOSTICS_IS_ON('SWFLUX ',myThid) ) THEN
101	DO bj = myByLo(myThid), myByHi(myThid)
102	DO bi = myBxLo(myThid), myBxHi(myThid)
103	DO j = 1,sNy
104	DO i = 1,sNx
105	tmp1k(i,j,bi,bj) = -Qsw(i,j,bi,bj)
106	ENDDO
107	ENDDO
108	ENDDO
109	ENDDO
110	CALL DIAGNOSTICS_FILL(tmp1k,'SWFLUX ',0,1,0,1,1,myThid)
111	ENDIF
112	#endif
113
114	C tIce (=Heat flux [W/m2] from melt/freeze of sea-ice, positive <-> increasing Theta)
115	tmpFac = HeatCapacity_Cprecip_horiVertRatiorhoConst
116	CALL DIAGNOSTICS_SCALE_FILL(surfaceForcingTice,tmpFac,1,
117	& 'TICE ',0, 1,0,1,1,myThid)
118
119	C sFlux (=salt flux [g/m2/s], positive <-> increasing Salt)
120	IF ( DIAGNOSTICS_IS_ON('SFLUX ',myThid) ) THEN
121	DO bj = myByLo(myThid), myByHi(myThid)
122	DO bi = myBxLo(myThid), myBxHi(myThid)
123	DO j = 1,sNy
124	DO i = 1,sNx
125	tmp1k(i,j,bi,bj) =
126	& surfaceForcingS(i,j,bi,bj)*
127	& recip_horiVertRatio*rhoConst
128	ENDDO
129	ENDDO
130	#ifdef NONLIN_FRSURF
131	IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
132	& .AND. useRealFreshWaterFlux ) THEN
133	DO j=1,sNy
134	DO i=1,sNx
135	tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj)
136	& + PmEpR(i,j,bi,bj)*rhoConstFresh
137	& *salt(i,j,ks,bi,bj)
138	ENDDO
139	ENDDO
140	ENDIF
141	#endif /* NONLIN_FRSURF */
142	ENDDO
143	ENDDO
144	CALL DIAGNOSTICS_FILL(tmp1k,'SFLUX ',0,1,0,1,1,myThid)
145	ENDIF
146	#endif /* ALLOW_DIAGNOSTICS */
147
148	RETURN
149	END