File indexing completed on 2018-03-02 18:36:37 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
8ab93ea9a3 Jean*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_OPTIONS.h"
0003
842349fcb7 Jean*0004
0005
0006
0007
0008
0009
8ab93ea9a3 Jean*0010
842349fcb7 Jean*0011
8ab93ea9a3 Jean*0012
d497465397 Jean*0013 SUBROUTINE DIAGS_RHO_L(
0014 I diagRho, k, bi, bj,
0015 I rho3d, rhoKm1, wFld,
842349fcb7 Jean*0016 I myTime, myIter, myThid )
8ab93ea9a3 Jean*0017
0018
d497465397 Jean*0019
0020
8ab93ea9a3 Jean*0021
842349fcb7 Jean*0022
8ab93ea9a3 Jean*0023
0024
0025
0026
0027 IMPLICIT NONE
0028
0029 #include "SIZE.h"
0030 #include "EEPARAMS.h"
0031 #include "PARAMS.h"
0032 #include "GRID.h"
0033
0034
0035
d497465397 Jean*0036
0037
0038
0039
0040
0041
0042
0043
0044
0045 INTEGER diagRho
842349fcb7 Jean*0046 INTEGER k, bi, bj
d497465397 Jean*0047 _RL rho3d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
8ab93ea9a3 Jean*0048 _RL rhoKm1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
842349fcb7 Jean*0049 _RL wFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
8ab93ea9a3 Jean*0050 _RL myTime
0051 INTEGER myIter, myThid
0052
0053
0054 #ifdef ALLOW_DIAGNOSTICS
0055
0056
0057
d497465397 Jean*0058
0059
8ab93ea9a3 Jean*0060 INTEGER i,j
8996cf5a3c Jean*0061 _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
8ab93ea9a3 Jean*0062
842349fcb7 Jean*0063
0064
d497465397 Jean*0065 IF ( k.GE.2 .AND. MOD(diagRho,8).GE.4 ) THEN
0066
0067
8ab93ea9a3 Jean*0068 DO j=1,sNy
0069 DO i=1,sNx
d497465397 Jean*0070 tmpFld(i,j) = wFld(i,j,k,bi,bj)
0071 & *( rho3d(i,j,k) - rhoKm1(i,j) )*rkSign
8ab93ea9a3 Jean*0072 ENDDO
0073 ENDDO
d497465397 Jean*0074 CALL DIAGNOSTICS_FILL(tmpFld,'WdRHO_P ',k,1,2,bi,bj,myThid)
0075 IF ( k.EQ.2 ) CALL DIAGNOSTICS_COUNT('WdRHO_P ',bi,bj,myThid)
0076 ENDIF
0077
0078 IF ( k.GE.2 .AND. diagRho.GE.8 ) THEN
0079
0080
8ab93ea9a3 Jean*0081 DO j=1,sNy
842349fcb7 Jean*0082 DO i=1,sNx
0083 tmpFld(i,j) = wFld(i,j,k,bi,bj)
d497465397 Jean*0084 & *( rhoKm1(i,j) - rho3d(i,j,k-1) )*rkSign
8ab93ea9a3 Jean*0085 ENDDO
0086 ENDDO
d497465397 Jean*0087 CALL DIAGNOSTICS_FILL(tmpFld,'WdRHOdP ',k,1,2,bi,bj,myThid)
0088 IF ( k.EQ.2 ) CALL DIAGNOSTICS_COUNT('WdRHOdP ',bi,bj,myThid)
8ab93ea9a3 Jean*0089 ENDIF
0090
842349fcb7 Jean*0091 #endif /* ALLOW_DIAGNOSTICS */
0092
0093 RETURN
0094 END
0095
0096
0097
0098
0099
d497465397 Jean*0100 SUBROUTINE DIAGS_RHO_G(
0101 I rho3d, uFld, vFld, wFld,
842349fcb7 Jean*0102 I myTime, myIter, myThid )
0103
0104
d497465397 Jean*0105
0106
842349fcb7 Jean*0107
0108
0109
0110
0111
0112
0113 IMPLICIT NONE
0114
0115 #include "SIZE.h"
0116 #include "EEPARAMS.h"
0117 #include "PARAMS.h"
0118 #include "GRID.h"
0119
0120
0121
d497465397 Jean*0122
0123
0124
0125
0126
0127
0128
842349fcb7 Jean*0129 _RL rho3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
0130 _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
0131 _RL vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
d497465397 Jean*0132 _RL wFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
842349fcb7 Jean*0133 _RL myTime
0134 INTEGER myIter, myThid
0135
0136
0137 #ifdef ALLOW_DIAGNOSTICS
d497465397 Jean*0138
0139 LOGICAL DIAGNOSTICS_IS_ON
0140 EXTERNAL DIAGNOSTICS_IS_ON
842349fcb7 Jean*0141
0142
0143
d497465397 Jean*0144
0145
0146
842349fcb7 Jean*0147 INTEGER i,j
0148 INTEGER k, bi,bj
0149 _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0150 _RL tmpFac
0151
0152
0153
0154 CALL DIAGNOSTICS_FILL( rho3d, 'RHOAnoma',
0155 & 0, Nr, 0, 1, 1, myThid )
0156 tmpFac = 1. _d 0
0157 CALL DIAGNOSTICS_SCALE_FILL( rho3d, tmpFac, 2,
0158 & 'RHOANOSQ', 0, Nr, 0, 1, 1, myThid )
0159
0160 IF ( DIAGNOSTICS_IS_ON('URHOMASS',myThid) ) THEN
0161 DO bj=myByLo(myThid),myByHi(myThid)
0162 DO bi=myBxLo(myThid),myBxHi(myThid)
0163 DO k=1,Nr
0164 DO j=1,sNy
0165 DO i=1,sNx+1
0166 tmpFld(i,j) = uFld(i,j,k,bi,bj)*_hFacW(i,j,k,bi,bj)
0167 & *(rho3d(i-1,j,k,bi,bj)+rho3d(i,j,k,bi,bj))
0168 & *0.5 _d 0
0169 ENDDO
0170 ENDDO
0171 CALL DIAGNOSTICS_FILL(tmpFld,'URHOMASS',k,1,2,bi,bj,myThid)
8ab93ea9a3 Jean*0172 ENDDO
0173 ENDDO
842349fcb7 Jean*0174 ENDDO
8ab93ea9a3 Jean*0175 ENDIF
0176
842349fcb7 Jean*0177 IF ( DIAGNOSTICS_IS_ON('VRHOMASS',myThid) ) THEN
0178 DO bj=myByLo(myThid),myByHi(myThid)
0179 DO bi=myBxLo(myThid),myBxHi(myThid)
0180 DO k=1,Nr
0181 DO j=1,sNy+1
0182 DO i=1,sNx
0183 tmpFld(i,j) = vFld(i,j,k,bi,bj)*_hFacS(i,j,k,bi,bj)
0184 & *(rho3d(i,j-1,k,bi,bj)+rho3d(i,j,k,bi,bj))
0185 & *0.5 _d 0
0186 ENDDO
0187 ENDDO
0188 CALL DIAGNOSTICS_FILL(tmpFld,'VRHOMASS',k,1,2,bi,bj,myThid)
8ab93ea9a3 Jean*0189 ENDDO
0190 ENDDO
842349fcb7 Jean*0191 ENDDO
8ab93ea9a3 Jean*0192 ENDIF
0193
d497465397 Jean*0194 IF ( DIAGNOSTICS_IS_ON('WRHOMASS',myThid) ) THEN
0195 DO bj=myByLo(myThid),myByHi(myThid)
0196 DO bi=myBxLo(myThid),myBxHi(myThid)
0197 DO k=1,Nr
0198 IF ( k.EQ.1 ) THEN
0199 DO j=1,sNy
0200 DO i=1,sNx
0201 tmpFld(i,j) = wFld(i,j,k,bi,bj)*rho3d(i,j,k,bi,bj)
0202 ENDDO
0203 ENDDO
0204 ELSE
0205 DO j=1,sNy
0206 DO i=1,sNx
0207 tmpFld(i,j) = wFld(i,j,k,bi,bj)
0208 & *(rho3d(i,j,k-1,bi,bj)+rho3d(i,j,k,bi,bj))
0209 & *0.5 _d 0
0210 ENDDO
0211 ENDDO
0212 ENDIF
0213 CALL DIAGNOSTICS_FILL(tmpFld,'WRHOMASS',k,1,2,bi,bj,myThid)
0214 ENDDO
0215 ENDDO
0216 ENDDO
0217 ENDIF
0218
8ab93ea9a3 Jean*0219 #endif /* ALLOW_DIAGNOSTICS */
0220
0221 RETURN
0222 END