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