pkg/diagnostics/diagnostics_fill_surf_flux.F

C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_fill_surf_flux.F,v 1.1 2004/12/17 19:17:57 dimitri Exp $
C $Name:  $

#include "DIAG_OPTIONS.h"

      SUBROUTINE DIAGNOSTICS_FILL_SURF_FLUX( myThid )

      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"

      INTEGER myThid 

#ifdef ALLOW_DIAGNOSTICS
      LOGICAL  DIAGNOSTICS_IS_ON
      EXTERNAL DIAGNOSTICS_IS_ON
      INTEGER i,j,K,bi,bj
      _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)

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

C-    taux (surface momentum flux [Pa=N/m2], positive <-> increase u)
      IF ( DIAGNOSTICS_IS_ON('TAUX    ',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) = fu(i,j,bi,bj)*foFacMom
            ENDDO
          ENDDO
        ENDDO
       ENDDO
       CALL DIAGNOSTICS_FILL(tmp1k,'TAUX    ',0,1,0,1,1,myThid)
      ENDIF

C-    tauy (surface momentum flux [Pa=N/m2], positive <-> increase v)
      IF ( DIAGNOSTICS_IS_ON('TAUY    ',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) = fv(i,j,bi,bj)*foFacMom
            ENDDO
          ENDDO
        ENDDO
       ENDDO
       CALL DIAGNOSTICS_FILL(tmp1k,'TAUY    ',0,1,0,1,1,myThid)
      ENDIF

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,k,bi,bj)*HeatCapacity_Cp
           ENDDO
          ENDDO
         ENDIF
#endif /* NONLIN_FRSURF */
        ENDDO
       ENDDO
       CALL DIAGNOSTICS_FILL(tmp1k,'TFLUX   ',0,1,0,1,1,myThid)
      ENDIF

C     tIce (=Heat flux [W/m2] from melt/freeze of sea-ice, positive <-> increasing Theta)
      IF ( DIAGNOSTICS_IS_ON('TICE    ',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) = surfaceForcingTice(I,J,bi,bj)
     &      *HeatCapacity_Cp*recip_horiVertRatio*rhoConst
          ENDDO
         ENDDO
        ENDDO
       ENDDO
       CALL DIAGNOSTICS_FILL(tmp1k,'TICE    ',0,1,0,1,1,myThid)
      ENDIF

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,k,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/pkg/diagnostics/diagnostics_fill_surf_flux.F,v 1.1 2004/12/17 19:17:57 dimitri Exp $
2	C $Name: $
3
4	#include "DIAG_OPTIONS.h"
5
6	SUBROUTINE DIAGNOSTICS_FILL_SURF_FLUX( myThid )
7
8	IMPLICIT NONE
9
10	C == Global variables ===
11	#include "SIZE.h"
12	#include "EEPARAMS.h"
13	#include "PARAMS.h"
14	#include "GRID.h"
15	#include "DYNVARS.h"
16	#include "SURFACE.h"
17	#include "FFIELDS.h"
18
19	INTEGER myThid
20
21	#ifdef ALLOW_DIAGNOSTICS
22	LOGICAL DIAGNOSTICS_IS_ON
23	EXTERNAL DIAGNOSTICS_IS_ON
24	INTEGER i,j,K,bi,bj
25	_RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
26
27	C- Time Averages of surface fluxes
28	IF ( usingPCoords ) THEN
29	k=Nr
30	ELSE
31	k=1
32	ENDIF
33
34	C- taux (surface momentum flux [Pa=N/m2], positive <-> increase u)
35	IF ( DIAGNOSTICS_IS_ON('TAUX ',myThid) ) THEN
36	DO bj = myByLo(myThid), myByHi(myThid)
37	DO bi = myBxLo(myThid), myBxHi(myThid)
38	DO j = 1,sNy
39	DO i = 1,sNx
40	tmp1k(i,j,bi,bj) = fu(i,j,bi,bj)*foFacMom
41	ENDDO
42	ENDDO
43	ENDDO
44	ENDDO
45	CALL DIAGNOSTICS_FILL(tmp1k,'TAUX ',0,1,0,1,1,myThid)
46	ENDIF
47
48	C- tauy (surface momentum flux [Pa=N/m2], positive <-> increase v)
49	IF ( DIAGNOSTICS_IS_ON('TAUY ',myThid) ) THEN
50	DO bj = myByLo(myThid), myByHi(myThid)
51	DO bi = myBxLo(myThid), myBxHi(myThid)
52	DO j = 1,sNy
53	DO i = 1,sNx
54	tmp1k(i,j,bi,bj) = fv(i,j,bi,bj)*foFacMom
55	ENDDO
56	ENDDO
57	ENDDO
58	ENDDO
59	CALL DIAGNOSTICS_FILL(tmp1k,'TAUY ',0,1,0,1,1,myThid)
60	ENDIF
61
62	C tFlux (=Heat flux [W/m2], positive <-> increasing Theta)
63	IF ( DIAGNOSTICS_IS_ON('TFLUX ',myThid) ) THEN
64	DO bj = myByLo(myThid), myByHi(myThid)
65	DO bi = myBxLo(myThid), myBxHi(myThid)
66	DO j = 1,sNy
67	DO i = 1,sNx
68	tmp1k(i,j,bi,bj) =
69	#ifdef SHORTWAVE_HEATING
70	& -Qsw(i,j,bi,bj)+
71	#endif
72	& (surfaceForcingT(i,j,bi,bj)+surfaceForcingTice(I,J,bi,bj))
73	& HeatCapacity_Cprecip_horiVertRatio*rhoConst
74	ENDDO
75	ENDDO
76	#ifdef NONLIN_FRSURF
77	IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
78	& .AND. useRealFreshWaterFlux ) THEN
79	DO j=1,sNy
80	DO i=1,sNx
81	tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj)
82	& + PmEpR(i,j,bi,bj)*rhoConstFresh
83	& theta(i,j,k,bi,bj)HeatCapacity_Cp
84	ENDDO
85	ENDDO
86	ENDIF
87	#endif /* NONLIN_FRSURF */
88	ENDDO
89	ENDDO
90	CALL DIAGNOSTICS_FILL(tmp1k,'TFLUX ',0,1,0,1,1,myThid)
91	ENDIF
92
93	C tIce (=Heat flux [W/m2] from melt/freeze of sea-ice, positive <-> increasing Theta)
94	IF ( DIAGNOSTICS_IS_ON('TICE ',myThid) ) THEN
95	DO bj = myByLo(myThid), myByHi(myThid)
96	DO bi = myBxLo(myThid), myBxHi(myThid)
97	DO j = 1,sNy
98	DO i = 1,sNx
99	tmp1k(i,j,bi,bj) = surfaceForcingTice(I,J,bi,bj)
100	& HeatCapacity_Cprecip_horiVertRatio*rhoConst
101	ENDDO
102	ENDDO
103	ENDDO
104	ENDDO
105	CALL DIAGNOSTICS_FILL(tmp1k,'TICE ',0,1,0,1,1,myThid)
106	ENDIF
107
108	C sFlux (=salt flux [g/m2/s], positive <-> increasing Salt)
109	IF ( DIAGNOSTICS_IS_ON('SFLUX ',myThid) ) THEN
110	DO bj = myByLo(myThid), myByHi(myThid)
111	DO bi = myBxLo(myThid), myBxHi(myThid)
112	DO j = 1,sNy
113	DO i = 1,sNx
114	tmp1k(i,j,bi,bj) =
115	& surfaceForcingS(i,j,bi,bj)*
116	& recip_horiVertRatio*rhoConst
117	ENDDO
118	ENDDO
119	#ifdef NONLIN_FRSURF
120	IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
121	& .AND. useRealFreshWaterFlux ) THEN
122	DO j=1,sNy
123	DO i=1,sNx
124	tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj)
125	& + PmEpR(i,j,bi,bj)*rhoConstFresh
126	& *salt(i,j,k,bi,bj)
127	ENDDO
128	ENDDO
129	ENDIF
130	#endif /* NONLIN_FRSURF */
131	ENDDO
132	ENDDO
133	CALL DIAGNOSTICS_FILL(tmp1k,'SFLUX ',0,1,0,1,1,myThid)
134	ENDIF
135	#endif /* ALLOW_DIAGNOSTICS */
136
137	RETURN
138	END