Back to home page

MITgcm

 
 

    


File indexing completed on 2025-07-08 05:10:42 UTC

view on githubraw file Latest commit 00c7090d on 2025-07-07 16:10:22 UTC
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) =
538310b333 Jean*0119      &      (surfaceForcingT(i,j,bi,bj)+adjustColdSST_diag(i,j,bi,bj))
0b1017b546 Jean*0120      &      *HeatCapacity_Cp*rUnit2mass
21cb76c218 Jean*0121           ENDDO
                0122          ENDDO
00c7090dc0 Mart*0123 #ifdef SHORTWAVE_HEATING
                0124          IF ( selectPenetratingSW .GE. 1 ) THEN
                0125           DO j = 1,sNy
                0126            DO i = 1,sNx
                0127             tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj) - Qsw(i,j,bi,bj)
                0128            ENDDO
                0129           ENDDO
                0130          ENDIF
                0131 #endif
21cb76c218 Jean*0132 #ifdef NONLIN_FRSURF
                0133          IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
                0134      &        .AND. useRealFreshWaterFlux ) THEN
                0135           DO j=1,sNy
                0136            DO i=1,sNx
                0137             tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj)
b5f408f39d Jean*0138      &       + PmEpR(i,j,bi,bj)*theta(i,j,ks,bi,bj)*HeatCapacity_Cp
21cb76c218 Jean*0139            ENDDO
                0140           ENDDO
                0141          ENDIF
                0142 #endif /* NONLIN_FRSURF */
                0143         ENDDO
                0144        ENDDO
b0bbe4b4f5 Jean*0145        CALL DIAGNOSTICS_FILL( tmp1k,'TFLUX   ',0,1,0,1,1,myThid )
cf336ab6c5 Ryan*0146 #ifdef ALLOW_LAYERS
ee16a2cae4 Ryan*0147        IF ( useLayers ) THEN
50d8304171 Ryan*0148         CALL LAYERS_FILL( tmp1k, 1, 'SUR', 0,1,0,1,1,myThid )
ee16a2cae4 Ryan*0149        ENDIF
cf336ab6c5 Ryan*0150 #endif /* ALLOW_LAYERS */
21cb76c218 Jean*0151       ENDIF
                0152 
b0bbe4b4f5 Jean*0153 C-    SFLUX (=total salt flux, match salt-content variations [g/m2/s])
c18b173e8a Jean*0154       IF ( fluidIsWater .AND.
                0155      &     DIAGNOSTICS_IS_ON('SFLUX   ',myThid) ) THEN
21cb76c218 Jean*0156        DO bj = myByLo(myThid), myByHi(myThid)
                0157         DO bi = myBxLo(myThid), myBxHi(myThid)
                0158          DO j = 1,sNy
                0159           DO i = 1,sNx
                0160            tmp1k(i,j,bi,bj) =
0b1017b546 Jean*0161      &      surfaceForcingS(i,j,bi,bj)*rUnit2mass
21cb76c218 Jean*0162           ENDDO
                0163          ENDDO
8f80badf99 Dimi*0164 
ee8b184348 Jean*0165 #ifdef NONLIN_FRSURF
                0166          IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
                0167      &        .AND. useRealFreshWaterFlux ) THEN
                0168           DO j=1,sNy
                0169            DO i=1,sNx
                0170             tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj)
b5f408f39d Jean*0171      &       + PmEpR(i,j,bi,bj)*salt(i,j,ks,bi,bj)
ee8b184348 Jean*0172            ENDDO
                0173           ENDDO
                0174          ENDIF
                0175 #endif /* NONLIN_FRSURF */
8f80badf99 Dimi*0176 
21cb76c218 Jean*0177         ENDDO
                0178        ENDDO
b0bbe4b4f5 Jean*0179        CALL DIAGNOSTICS_FILL( tmp1k,'SFLUX   ',0,1,0,1,1,myThid )
cf336ab6c5 Ryan*0180 #ifdef ALLOW_LAYERS
ee16a2cae4 Ryan*0181        IF ( useLayers ) THEN
50d8304171 Ryan*0182         CALL LAYERS_FILL( tmp1k, 2, 'SUR', 0,1,0,1,1,myThid )
ee16a2cae4 Ryan*0183        ENDIF
cf336ab6c5 Ryan*0184 #endif /* ALLOW_LAYERS */
21cb76c218 Jean*0185       ENDIF
                0186 #endif /* ALLOW_DIAGNOSTICS */
                0187 
b0bbe4b4f5 Jean*0188       RETURN
21cb76c218 Jean*0189       END