File indexing completed on 2018-03-02 18:38:56 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
337bea277a Jean*0001 #include "DIAG_OPTIONS.h"
0002
228efec02b Jean*0003
0004
0005
8c4f953ef4 Jean*0006 SUBROUTINE DIAGNOSTICS_FILL(
62f9c88755 Jean*0007 I inpFld, chardiag,
0008 I kLev, nLevs, bibjFlg, biArg, bjArg, myThid )
228efec02b Jean*0009
0010
337bea277a Jean*0011
2d87091177 Jean*0012
228efec02b Jean*0013
0014
0015 IMPLICIT NONE
0016
0017
0018 #include "EEPARAMS.h"
0019 #include "SIZE.h"
0020 #include "DIAGNOSTICS_SIZE.h"
0021 #include "DIAGNOSTICS.h"
0022
0023
0024
337bea277a Jean*0025
0026
8c4f953ef4 Jean*0027
0028
0029
ec6884a5db Jean*0030
0031
3ae5f90260 Jean*0032
ec6884a5db Jean*0033
8c4f953ef4 Jean*0034
ec6884a5db Jean*0035
8c4f953ef4 Jean*0036
337bea277a Jean*0037
0038
0039
0040
35876c174e Dimi*0041
337bea277a Jean*0042
0043
0044
3ae5f90260 Jean*0045
8c4f953ef4 Jean*0046
0047
0048
337bea277a Jean*0049
0050
3ae5f90260 Jean*0051
337bea277a Jean*0052
0053
8c4f953ef4 Jean*0054 _RL inpFld(*)
228efec02b Jean*0055 CHARACTER*8 chardiag
3ae5f90260 Jean*0056 INTEGER kLev, nLevs, bibjFlg, biArg, bjArg
228efec02b Jean*0057 INTEGER myThid
0058
0059
0060
3ae5f90260 Jean*0061
0062 INTEGER m, n, j, k, l, bi, bj
0063 INTEGER ndId, ipt, iSp
3e5de6a370 Jean*0064 INTEGER region2fill(0:nRegions)
e24eb5a158 Jean*0065 INTEGER arrType, wFac
8c4f953ef4 Jean*0066 _RL scaleFact
2d87091177 Jean*0067 _RL dummyRL(1)
0068 _RS dummyRS(1)
0069
337bea277a Jean*0070
102b7abbed Jean*0071
0072
0073 IF ( diag_pkgStatus.NE.ready2fillDiags ) THEN
0074 CALL DIAGNOSTICS_STATUS_ERROR( 'DIAGNOSTICS_FILL',
0075 & ' ', chardiag, ready2fillDiags, myThid )
0076 ENDIF
0077
2d87091177 Jean*0078 arrType = 0
8c4f953ef4 Jean*0079 scaleFact = 1. _d 0
3ae5f90260 Jean*0080 IF ( bibjFlg.EQ.0 ) THEN
970e63b3d6 Jean*0081 bi = myBxLo(myThid)
0082 bj = myByLo(myThid)
3ae5f90260 Jean*0083 ELSE
0084 bi = biArg
0085 bj = bjArg
0086 ENDIF
90d17db25d Jean*0087
337bea277a Jean*0088
0089
0090 DO n=1,nlists
0091 DO m=1,nActive(n)
3ae5f90260 Jean*0092 IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN
0093 ipt = idiag(m,n)
0094 IF ( ndiag(ipt,bi,bj).GE.0 ) THEN
e24eb5a158 Jean*0095 ndId = ABS(jdiag(m,n))
0096 wFac = MIN( jdiag(m,n), 0 )
666b944083 Jean*0097 ipt = ipt + pdiag(n,bi,bj)*kdiag(ndId)
8c4f953ef4 Jean*0098
0099 CALL DIAGNOSTICS_FILL_FIELD(
2d87091177 Jean*0100 I inpFld, dummyRL, dummyRS, dummyRS,
e24eb5a158 Jean*0101 I scaleFact, 1, arrType, wFac,
62f9c88755 Jean*0102 I ndId, ipt, kLev, nLevs,
0103 I bibjFlg, biArg, bjArg, myThid )
3ae5f90260 Jean*0104 ENDIF
337bea277a Jean*0105 ENDIF
0106 ENDDO
0107 ENDDO
0108
0109
3e5de6a370 Jean*0110
0111
0112
0113
0114
0115 DO n=1,diagSt_nbLists
0116 DO m=1,diagSt_nbActv(n)
3ae5f90260 Jean*0117 IF ( chardiag.EQ.diagSt_Flds(m,n) .AND. iSdiag(m,n).GT.0 ) THEN
0118 iSp = iSdiag(m,n)
0119 IF ( qSdiag(0,0,iSp,bi,bj).GE.0. ) THEN
8c4f953ef4 Jean*0120 ndId = jSdiag(m,n)
0121
3e5de6a370 Jean*0122 DO j=0,nRegions
0123 region2fill(j) = diagSt_region(j,n)
0124 ENDDO
8c4f953ef4 Jean*0125
0126
3ae5f90260 Jean*0127 DO l=1,diagSt_nbLists
0128 DO k=1,diagSt_nbActv(l)
0129 IF ( iSdiag(k,l).EQ.-iSp ) THEN
0130 DO j=0,nRegions
0131 region2fill(j) = MAX(region2fill(j),diagSt_region(j,l))
0132 ENDDO
0133 ENDIF
0134 ENDDO
3e5de6a370 Jean*0135 ENDDO
8c4f953ef4 Jean*0136
0137 CALL DIAGSTATS_FILL(
2d87091177 Jean*0138 I inpFld, dummyRL,
0139 #ifndef REAL4_IS_SLOW
0140 I dummyRS, dummyRS,
0141 #endif
0142 I scaleFact, 1, arrType, 0,
62f9c88755 Jean*0143 I ndId, iSp, region2fill, kLev, nLevs,
0144 I bibjFlg, biArg, bjArg, myThid )
3e5de6a370 Jean*0145 ENDIF
0146 ENDIF
0147 ENDDO
0148 ENDDO
0149
3ae5f90260 Jean*0150 RETURN
228efec02b Jean*0151 END