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