** Warning **
Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.
Last-Modified: Wed, 4 Nov 2025 06:09:27 GMT
Content-Type: text/html; charset=utf-8
MITgcm/MITgcm/pkg/monitor/mon_surfcor.F
File indexing completed on 2018-03-02 18:42:22 UTC
view on github raw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
91672e10e3 Alis* 0001 #include "MONITOR_OPTIONS.h "
af45a4871a Jean* 0002
2741539ec0 Ed H* 0003
0004
0005
0006
0007
af45a4871a Jean* 0008 SUBROUTINE MON_SURFCOR (
3b8508515d Jean* 0009 I myThid )
af45a4871a Jean* 0010
2741539ec0 Ed H* 0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0b1017b546 Jean* 0021
2741539ec0 Ed H* 0022
0023
0024
0025
0026
0b1017b546 Jean* 0027
0028
2741539ec0 Ed H* 0029
0030
0031
0b1017b546 Jean* 0032
2741539ec0 Ed H* 0033
0034
0035
0036 IMPLICIT NONE
af45a4871a Jean* 0037 #include "SIZE.h "
0038 #include "EEPARAMS.h "
0039 #include "PARAMS.h "
0040 #include "DYNVARS.h "
0041 #include "SURFACE.h "
0042 #include "GRID.h "
0043 #include "MONITOR.h "
0044
2741539ec0 Ed H* 0045
3b8508515d Jean* 0046
af45a4871a Jean* 0047 INTEGER myThid
2741539ec0 Ed H* 0048
af45a4871a Jean* 0049
2741539ec0 Ed H* 0050
0b1017b546 Jean* 0051 INTEGER i ,j ,k ,ks ,bi ,bj
edc5c0b6b1 Jean* 0052 _RL theArea , wT_Mean , wS_Mean
0053 _RL wT_Heat , theta2PE
8996cf5a3c Jean* 0054 _RL tmpVal , ddPI
4d2b0c1389 Jean* 0055 _RL tileArea (nSx ,nSy )
0056 _RL tile_wT (nSx ,nSy )
0057 _RL tile_wS (nSx ,nSy )
0058 _RL tileWHeat (nSx ,nSy )
0059 _RL tileTh2pe (nSx ,nSy )
8996cf5a3c Jean* 0060 #ifdef NONLIN_FRSURF
0061 _RL tmpVol , conv_th2Heat
edc5c0b6b1 Jean* 0062 _RL vT_Mean , vS_Mean , vT_Heat
8996cf5a3c Jean* 0063 #endif
af45a4871a Jean* 0064
0065
3b8508515d Jean* 0066
af45a4871a Jean* 0067 theArea = 0.
0068 wT_Mean = 0.
0069 wS_Mean = 0.
0070 wT_Heat = 0.
4d2b0c1389 Jean* 0071 theta2PE = 0.
af45a4871a Jean* 0072 DO bj =myByLo (myThid ),myByHi (myThid )
0b1017b546 Jean* 0073 DO bi =myBxLo (myThid ),myBxHi (myThid )
4d2b0c1389 Jean* 0074 tileArea (bi ,bj ) = 0.
0075 tile_wT (bi ,bj ) = 0.
0076 tile_wS (bi ,bj ) = 0.
0077 tileWHeat (bi ,bj ) = 0.
0078 tileTh2pe (bi ,bj ) = 0.
1fd0930642 Jean* 0079
af45a4871a Jean* 0080 DO j =1,sNy
0081 DO i =1,sNx
0082 ks = ksurfC (i ,j ,bi ,bj )
0083 IF (ks .LE. Nr ) THEN
3b8508515d Jean* 0084 tileArea (bi ,bj ) = tileArea (bi ,bj )
0085 & + rA (i ,j ,bi ,bj )*maskInC (i ,j ,bi ,bj )
0086 tmpVal = rA (i ,j ,bi ,bj )*maskInC (i ,j ,bi ,bj )
0087 & *wVel (i ,j ,ks ,bi ,bj )*theta (i ,j ,ks ,bi ,bj )
4d2b0c1389 Jean* 0088 tile_wT (bi ,bj ) = tile_wT (bi ,bj ) + tmpVal
0089 tile_wS (bi ,bj ) = tile_wS (bi ,bj )
3b8508515d Jean* 0090 & + rA (i ,j ,bi ,bj )*maskInC (i ,j ,bi ,bj )
0091 & *wVel (i ,j ,ks ,bi ,bj )*salt (i ,j ,ks ,bi ,bj )
1fd0930642 Jean* 0092
4d2b0c1389 Jean* 0093 IF ( fluidIsAir ) THEN
0094 tileWHeat (bi ,bj ) = tileWHeat (bi ,bj )
0b1017b546 Jean* 0095 & + tmpVal *atm_cp *((rC (ks )/atm_po )**atm_kappa )
af45a4871a Jean* 0096 ENDIF
0097 ENDIF
0098 ENDDO
0099 ENDDO
1fd0930642 Jean* 0100 #ifdef ALLOW_AIM
0101 IF ( useAIM ) THEN
4d2b0c1389 Jean* 0102 tile_wS (bi ,bj ) = 0.
1fd0930642 Jean* 0103 DO j =1,sNy
0104 DO i =1,sNx
0105 ks = ksurfC (i ,j ,bi ,bj )
0b1017b546 Jean* 0106 IF (ks .LE. Nr ) THEN
1fd0930642 Jean* 0107 tmpVal = salt (i ,j ,ks ,bi ,bj )
0108 & + salt (i ,j ,Nr ,bi ,bj )*drF (Nr )*recip_drF (ks )
616600b8d2 Patr* 0109 & *hFacC (i ,j ,Nr ,bi ,bj )*_recip_hFacC (i ,j ,ks ,bi ,bj )
4d2b0c1389 Jean* 0110 tile_wS (bi ,bj ) = tile_wS (bi ,bj )
3b8508515d Jean* 0111 & + rA (i ,j ,bi ,bj )*maskInC (i ,j ,bi ,bj )
0112 & *wVel (i ,j ,ks ,bi ,bj )*tmpVal
1fd0930642 Jean* 0113 ENDIF
0114 ENDDO
0115 ENDDO
0116 ENDIF
0117 #endif /* ALLOW_AIM */
0118
0119
0b1017b546 Jean* 0120
af45a4871a Jean* 0121
4d2b0c1389 Jean* 0122 IF ( fluidIsAir ) THEN
af45a4871a Jean* 0123 DO k =2,Nr
0124 ddPI =atm_cp *( (rC (K -1)/atm_po )**atm_kappa
0125 & -(rC ( K )/atm_po )**atm_kappa )
0126 DO j =1,sNy
0127 DO i =1,sNx
4d2b0c1389 Jean* 0128 tileTh2pe (bi ,bj ) = tileTh2pe (bi ,bj )
af45a4871a Jean* 0129 & - ddPI *rA (i ,j ,bi ,bj )*wVel (i ,j ,k ,bi ,bj )
0130 & *(theta (i ,j ,k ,bi ,bj )+theta (i ,j ,k -1,bi ,bj ))*0.5 _d 0
0131 & *maskC (i ,j ,k -1,bi ,bj )*maskC (i ,j ,k ,bi ,bj )
3b8508515d Jean* 0132 & *maskInC (i ,j ,bi ,bj )
af45a4871a Jean* 0133 ENDDO
0134 ENDDO
0135 ENDDO
0136 ENDIF
1fd0930642 Jean* 0137
0138 #ifdef NONLIN_FRSURF
0139
0b1017b546 Jean* 0140 IF (select_rStar .NE. 0) THEN
1fd0930642 Jean* 0141
0142 vT_Mean = 0.
0143 vS_Mean = 0.
0144 vT_Heat = 0.
cae30f03da Jean* 0145 conv_th2Heat = 0.
1fd0930642 Jean* 0146 DO k =1,Nr
0b1017b546 Jean* 0147 IF (fluidIsAir ) conv_th2Heat =
cae30f03da Jean* 0148 & atm_cp *((rC (k )/atm_po )**atm_kappa )
af45a4871a Jean* 0149 DO j =1,sNy
0150 DO i =1,sNx
1fd0930642 Jean* 0151 tmpVol = rA (i ,j ,bi ,bj )*h0FacC (i ,j ,k ,bi ,bj )*drF (k )
3b8508515d Jean* 0152 & *maskInC (i ,j ,bi ,bj )
1fd0930642 Jean* 0153 tmpVal = rStarDhCDt (i ,j ,bi ,bj )*theta (i ,j ,k ,bi ,bj )
0154 vT_Mean = vT_Mean + tmpVol *tmpVal
0155 vS_Mean = vS_Mean
0156 & +tmpVol *rStarDhCDt (i ,j ,bi ,bj )*salt (i ,j ,k ,bi ,bj )
0157
0b1017b546 Jean* 0158 IF (fluidIsAir ) vT_Heat = vT_Heat
cae30f03da Jean* 0159 & + tmpVol *tmpVal *conv_th2Heat
af45a4871a Jean* 0160 ENDDO
0161 ENDDO
0b1017b546 Jean* 0162 ENDDO
4d2b0c1389 Jean* 0163 tile_wT (bi ,bj ) = tile_wT (bi ,bj ) + vT_Mean
0164 tile_wS (bi ,bj ) = tile_wS (bi ,bj ) + vS_Mean
0165 tileWHeat (bi ,bj ) = tileWHeat (bi ,bj ) + vT_Heat
1fd0930642 Jean* 0166 ENDIF
0167
0168 #endif /* NONLIN_FRSURF */
0169
0b1017b546 Jean* 0170
af45a4871a Jean* 0171 ENDDO
0172 ENDDO
0173
4d2b0c1389 Jean* 0174 CALL GLOBAL_SUM_TILE_RL ( tileArea , theArea , myThid )
0175 CALL GLOBAL_SUM_TILE_RL ( tile_wT , wT_Mean , myThid )
0176 CALL GLOBAL_SUM_TILE_RL ( tile_wS , wS_Mean , myThid )
0177 IF ( fluidIsAir ) THEN
0178 CALL GLOBAL_SUM_TILE_RL ( tileWHeat , wT_Heat , myThid )
0179 CALL GLOBAL_SUM_TILE_RL ( tileTh2pe , theta2PE , myThid )
af45a4871a Jean* 0180 ENDIF
0181 IF (theArea .GT. 0.) THEN
0182 wT_Mean = wT_Mean / theArea
0183 wS_Mean = wS_Mean / theArea
0184 wT_Heat = wT_Heat / theArea
0185 theta2PE = theta2PE / theArea
0b1017b546 Jean* 0186 wT_Heat = wT_Heat * rUnit2mass
0187 theta2PE = theta2PE * rUnit2mass
af45a4871a Jean* 0188 ENDIF
0189
1fd0930642 Jean* 0190
af45a4871a Jean* 0191
1fd0930642 Jean* 0192 CALL MON_SET_PREF ('surfExpan' ,myThid )
af45a4871a Jean* 0193 CALL MON_OUT_RL ( '_theta' , wT_Mean , mon_foot_mean ,myThid )
0194 CALL MON_OUT_RL ( '_salt' , wS_Mean , mon_foot_mean ,myThid )
4d2b0c1389 Jean* 0195 IF ( fluidIsAir ) THEN
af45a4871a Jean* 0196 CALL MON_OUT_RL ( '_Heat' , wT_Heat , mon_foot_mean ,myThid )
0197 CALL MON_SET_PREF ('En_Budget' ,myThid )
0198 CALL MON_OUT_RL ('_T2PE' ,theta2PE , mon_foot_mean ,myThid )
0199 ENDIF
0200
0201
0202
0203 RETURN
0204 END