model/src/diags_oceanic_surf_flux.F

21cb76c218 Jean*0001 #include "PACKAGES_CONFIG.h"
                0002 #include "CPP_OPTIONS.h"
                0003
                0004 CBOP
                0005 C     !ROUTINE: DIAGS_OCEANIC_SURF_FLUX
                0006 C     !INTERFACE:
                0007       SUBROUTINE DIAGS_OCEANIC_SURF_FLUX( myTime, myIter, myThid )
                0008
                0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
                0011 C     | SUBROUTINE DIAGS_OCEANIC_SURF_FLUX
                0012 C     | o Compute Diagnostics of Surface Fluxes (ocean only)
                0013 C     *==========================================================*
                0014 C     \ev
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018
                0019 C     == Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "GRID.h"
                0024 #include "DYNVARS.h"
                0025 #include "SURFACE.h"
                0026 #include "FFIELDS.h"
9b89fcf692 antn*0027 #ifdef ALLOW_LAYERS
                0028 # include "LAYERS_P2SHARE.h"
                0029 #endif
21cb76c218 Jean*0030
                0031 C     !INPUT/OUTPUT PARAMETERS:
                0032 C     == Routine arguments ==
                0033 C     myTime :: Current time in simulation
                0034 C     myIter :: Current iteration number in simulation
                0035 C     myThid :: Thread number for this instance of the routine.
                0036       _RL myTime
                0037       INTEGER myIter
b0bbe4b4f5 Jean*0038       INTEGER myThid
21cb76c218 Jean*0039 CEOP
                0040
                0041 #ifdef ALLOW_DIAGNOSTICS
2e1c236acd Jean*0042 C     !FUNCTIONS:
                0043       LOGICAL  DIAGNOSTICS_IS_ON
                0044       EXTERNAL DIAGNOSTICS_IS_ON
                0045
21cb76c218 Jean*0046 C     !LOCAL VARIABLES:
                0047 C     i,j,bi,bj :: loop indices
                0048 C     ks        :: surface level index
                0049       INTEGER i,j,bi,bj
                0050       INTEGER ks
                0051       _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0052       _RL tmpFac
                0053
                0054 C-    Time Averages of surface fluxes
                0055        IF ( usingPCoords ) THEN
                0056         ks=Nr
                0057        ELSE
                0058         ks=1
                0059        ENDIF
                0060
b0bbe4b4f5 Jean*0061 C-    net Fresh Water flux into the ocean (+=down), [kg/m2/s]
b5f408f39d Jean*0062        tmpFac = -1. _d 0
2841828649 Jean*0063        CALL DIAGNOSTICS_SCALE_FILL_RS( EmPmR,tmpFac,1,
b0bbe4b4f5 Jean*0064      &                             'oceFWflx',0, 1,0,1,1,myThid )
                0065
ba0b047096 Mart*0066 C-    net Salt flux into the ocean (+=down), [g/m2/s]
b0bbe4b4f5 Jean*0067        tmpFac = -1. _d 0
2841828649 Jean*0068        CALL DIAGNOSTICS_SCALE_FILL_RS( saltFlux,tmpFac,1,
b0bbe4b4f5 Jean*0069      &                             'oceSflux',0, 1,0,1,1,myThid )
                0070
                0071 C-    Qnet (= net heat flux into the ocean, +=down, [W/m2])
                0072        tmpFac = -1. _d 0
2841828649 Jean*0073        CALL DIAGNOSTICS_SCALE_FILL_RS( Qnet,tmpFac,1,
b0bbe4b4f5 Jean*0074      &                             'oceQnet ',0, 1,0,1,1,myThid )
                0075
                0076 C-    Qsw (= net short-wave into the ocean, +=down, [W/m2])
                0077        tmpFac = -1. _d 0
2841828649 Jean*0078        CALL DIAGNOSTICS_SCALE_FILL_RS( Qsw,tmpFac,1,
b0bbe4b4f5 Jean*0079      &                             'oceQsw  ',0, 1,0,1,1,myThid )
                0080
c18b173e8a Jean*0081       IF ( fluidIsWater .OR. useAtm_Phys ) THEN
                0082 C-    taux (surface momentum flux [Pa=N/m2], +=down = increase u-oce)
                0083        CALL DIAGNOSTICS_SCALE_FILL_RS( fu,foFacMom,1,
                0084      &                             'oceTAUX ',0, 1,0,1,1,myThid )
                0085
                0086 C-    tauy (surface momentum flux [Pa=N/m2], +=down = increase v-oce)
                0087        CALL DIAGNOSTICS_SCALE_FILL_RS( fv,foFacMom,1,
                0088      &                             'oceTAUY ',0, 1,0,1,1,myThid )
                0089       ENDIF
                0090
                0091 C-    sea-ice loading (expressed in Mass of ice+snow / area unit, [kg/m2])
                0092        CALL DIAGNOSTICS_FILL_RS( sIceLoad,'sIceLoad',0,1,0,1,1,myThid )
                0093
                0094       IF ( fluidIsWater ) THEN
118f5617eb Jean*0095 C-    pLoad (Atmospheric pressure anomaly relative to surf_pRef [Pa=N/m2])
c18b173e8a Jean*0096        CALL DIAGNOSTICS_FILL_RS( pLoad,   'atmPload',0,1,0,1,1,myThid )
                0097
b0bbe4b4f5 Jean*0098 C-    oceFreez (= heating from freezing of sea-water, if allowFreezing=T)
0b1017b546 Jean*0099        tmpFac = HeatCapacity_Cp*rUnit2mass
538310b333 Jean*0100        CALL DIAGNOSTICS_SCALE_FILL( adjustColdSST_diag,tmpFac,1,
b0bbe4b4f5 Jean*0101      &                             'oceFreez',0, 1,0,1,1,myThid )
                0102
                0103 C-    surForcT (=model surface forcing for Temperature [W/m2], >0 increases T
0b1017b546 Jean*0104        tmpFac = HeatCapacity_Cp*rUnit2mass
b0bbe4b4f5 Jean*0105        CALL DIAGNOSTICS_SCALE_FILL( surfaceForcingT,tmpFac,1,
                0106      &                             'surForcT',0, 1,0,1,1,myThid )
                0107
                0108 C-    surForcS (=model surface forcing for Salinity, [g/m2/s], >0 increases S
0b1017b546 Jean*0109        tmpFac = rUnit2mass
b0bbe4b4f5 Jean*0110        CALL DIAGNOSTICS_SCALE_FILL( surfaceForcingS,tmpFac,1,
                0111      &                             'surForcS',0, 1,0,1,1,myThid )
c18b173e8a Jean*0112       ENDIF
b0bbe4b4f5 Jean*0113
                0114 C-    TFLUX (=total heat flux, match heat-content variations, [W/m2])
9b89fcf692 antn*0115       IF ( fluidIsWater .AND. (
                0116      &     DIAGNOSTICS_IS_ON('TFLUX   ',myThid)
                0117 #ifdef ALLOW_LAYERS
                0118      &     .OR. layers_useThermo
                0119 #endif
                0120      &     ) ) THEN
21cb76c218 Jean*0121        DO bj = myByLo(myThid), myByHi(myThid)
                0122         DO bi = myBxLo(myThid), myBxHi(myThid)
                0123          DO j = 1,sNy
                0124           DO i = 1,sNx
                0125            tmp1k(i,j,bi,bj) =
538310b333 Jean*0126      &      (surfaceForcingT(i,j,bi,bj)+adjustColdSST_diag(i,j,bi,bj))
0b1017b546 Jean*0127      &      *HeatCapacity_Cp*rUnit2mass
21cb76c218 Jean*0128           ENDDO
                0129          ENDDO
00c7090dc0 Mart*0130 #ifdef SHORTWAVE_HEATING
                0131          IF ( selectPenetratingSW .GE. 1 ) THEN
                0132           DO j = 1,sNy
                0133            DO i = 1,sNx
                0134             tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj) - Qsw(i,j,bi,bj)
                0135            ENDDO
                0136           ENDDO
                0137          ENDIF
                0138 #endif
21cb76c218 Jean*0139 #ifdef NONLIN_FRSURF
                0140          IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
                0141      &        .AND. useRealFreshWaterFlux ) THEN
                0142           DO j=1,sNy
                0143            DO i=1,sNx
                0144             tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj)
b5f408f39d Jean*0145      &       + PmEpR(i,j,bi,bj)*theta(i,j,ks,bi,bj)*HeatCapacity_Cp
21cb76c218 Jean*0146            ENDDO
                0147           ENDDO
                0148          ENDIF
                0149 #endif /* NONLIN_FRSURF */
                0150         ENDDO
                0151        ENDDO
b0bbe4b4f5 Jean*0152        CALL DIAGNOSTICS_FILL( tmp1k,'TFLUX   ',0,1,0,1,1,myThid )
cf336ab6c5 Ryan*0153 #ifdef ALLOW_LAYERS
9b89fcf692 antn*0154        IF ( layers_useThermo ) THEN
50d8304171 Ryan*0155         CALL LAYERS_FILL( tmp1k, 1, 'SUR', 0,1,0,1,1,myThid )
ee16a2cae4 Ryan*0156        ENDIF
cf336ab6c5 Ryan*0157 #endif /* ALLOW_LAYERS */
21cb76c218 Jean*0158       ENDIF
                0159
b0bbe4b4f5 Jean*0160 C-    SFLUX (=total salt flux, match salt-content variations [g/m2/s])
9b89fcf692 antn*0161       IF ( fluidIsWater .AND. (
                0162      &     DIAGNOSTICS_IS_ON('SFLUX   ',myThid)
                0163 #ifdef ALLOW_LAYERS
                0164      &     .OR. layers_useThermo
                0165 #endif
                0166      &     ) ) THEN
21cb76c218 Jean*0167        DO bj = myByLo(myThid), myByHi(myThid)
                0168         DO bi = myBxLo(myThid), myBxHi(myThid)
                0169          DO j = 1,sNy
                0170           DO i = 1,sNx
                0171            tmp1k(i,j,bi,bj) =
0b1017b546 Jean*0172      &      surfaceForcingS(i,j,bi,bj)*rUnit2mass
21cb76c218 Jean*0173           ENDDO
                0174          ENDDO
8f80badf99 Dimi*0175
ee8b184348 Jean*0176 #ifdef NONLIN_FRSURF
                0177          IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
                0178      &        .AND. useRealFreshWaterFlux ) THEN
                0179           DO j=1,sNy
                0180            DO i=1,sNx
                0181             tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj)
b5f408f39d Jean*0182      &       + PmEpR(i,j,bi,bj)*salt(i,j,ks,bi,bj)
ee8b184348 Jean*0183            ENDDO
                0184           ENDDO
                0185          ENDIF
                0186 #endif /* NONLIN_FRSURF */
8f80badf99 Dimi*0187
21cb76c218 Jean*0188         ENDDO
                0189        ENDDO
b0bbe4b4f5 Jean*0190        CALL DIAGNOSTICS_FILL( tmp1k,'SFLUX   ',0,1,0,1,1,myThid )
cf336ab6c5 Ryan*0191 #ifdef ALLOW_LAYERS
9b89fcf692 antn*0192        IF ( layers_useThermo ) THEN
50d8304171 Ryan*0193         CALL LAYERS_FILL( tmp1k, 2, 'SUR', 0,1,0,1,1,myThid )
ee16a2cae4 Ryan*0194        ENDIF
cf336ab6c5 Ryan*0195 #endif /* ALLOW_LAYERS */
21cb76c218 Jean*0196       ENDIF
                0197 #endif /* ALLOW_DIAGNOSTICS */
                0198
b0bbe4b4f5 Jean*0199       RETURN
21cb76c218 Jean*0200       END