MITgcm |
|
|
|
|||
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 UTCbb32d08f4a Jean*0001 #include "DIAG_OPTIONS.h" 0002 0003 CBOP 0004 C !ROUTINE: DIAGNOSTICS_SCALE_FILL_RS 0005 C !INTERFACE: 0006 SUBROUTINE DIAGNOSTICS_SCALE_FILL_RS( 0007 I inpFld, scaleFact, power, chardiag, 0008 I kLev, nLevs, bibjFlg, biArg, bjArg, myThid ) 0009 0010 C !DESCRIPTION: 0011 C*********************************************************************** 0012 C Wrapper routine to increment the diagnostics arrays with a RS field 0013 C using a scaling factor & square option (power=2) 0014 C*********************************************************************** 0015 C !USES: 0016 IMPLICIT NONE 0017 0018 C == Global variables === 0019 #include "EEPARAMS.h" 0020 #include "SIZE.h" 0021 #include "DIAGNOSTICS_SIZE.h" 0022 #include "DIAGNOSTICS.h" 0023 0024 C !INPUT PARAMETERS: 0025 C*********************************************************************** 0026 C Arguments Description 0027 C ---------------------- 0028 C inpFld :: Field to increment diagnostics array 0029 C scaleFact :: scaling factor 0030 C power :: option to fill-in with the field square (power=2) 0031 C chardiag :: Character expression for diag to fill 0032 C kLev :: Integer flag for vertical levels: 0033 C > 0 (any integer): WHICH single level to increment in qdiag. 0034 C 0,-1 to increment "nLevs" levels in qdiag, 0035 C 0 : fill-in in the same order as the input array 0036 C -1: fill-in in reverse order. 0037 C nLevs :: indicates Number of levels of the input field array 0038 C (whether to fill-in all the levels (kLev<1) or just one (kLev>0)) 0039 C bibjFlg :: Integer flag to indicate instructions for bi bj loop 0040 C 0 indicates that the bi-bj loop must be done here 0041 C 1 indicates that the bi-bj loop is done OUTSIDE 0042 C 2 indicates that the bi-bj loop is done OUTSIDE 0043 C AND that we have been sent a local array (with overlap regions) 0044 C 3 indicates that the bi-bj loop is done OUTSIDE 0045 C AND that we have been sent a local array 0046 C AND that the array has no overlap region (interior only) 0047 C NOTE - bibjFlg can be NEGATIVE to indicate not to increment counter 0048 C biArg :: X-direction tile number - used for bibjFlg=1-3 0049 C bjArg :: Y-direction tile number - used for bibjFlg=1-3 0050 C myThid :: my thread Id number 0051 C*********************************************************************** 0052 C NOTE: User beware! If a local (1 tile only) array 0053 C is sent here, bibjFlg MUST NOT be set to 0 0054 C or there will be out of bounds problems! 0055 C*********************************************************************** 0056 _RS inpFld(*) 0057 _RL scaleFact 0058 INTEGER power 0059 CHARACTER*8 chardiag 0060 INTEGER kLev, nLevs, bibjFlg, biArg, bjArg 0061 INTEGER myThid 0062 CEOP 0063 0064 C !LOCAL VARIABLES: 0065 C ndId :: diagnostic Id number (in available diagnostics list) 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 bb32d08f4a Jean*0070 _RL dummyRL(1) 0071 _RS dummyRS(1) 0072 C =============== 0073 102b7abbed Jean*0074 C-- Check if this S/R is called from the right place ; 0075 C needs to be after DIAGNOSTICS_SWITCH_ONOFF and before DIAGNOSTICS_WRITE 0076 IF ( diag_pkgStatus.NE.ready2fillDiags ) THEN 0077 CALL DIAGNOSTICS_STATUS_ERROR( 'DIAGNOSTICS_SCALE_FILL_RS', 0078 & ' ', chardiag, ready2fillDiags, myThid ) 0079 ENDIF 0080 bb32d08f4a Jean*0081 arrType = 2 0082 IF ( bibjFlg.EQ.0 ) THEN 0083 bi = myBxLo(myThid) 0084 bj = myByLo(myThid) 0085 ELSE 0086 bi = biArg 0087 bj = bjArg 0088 ENDIF 0089 C-- 2D/3D Diagnostics : 0090 C Run through list of active diagnostics to make sure 0091 C we are trying to fill a valid diagnostic 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 ) bb32d08f4a Jean*0099 ipt = ipt + pdiag(n,bi,bj)*kdiag(ndId) 0100 C- diagnostic is valid & active, do the filling: 0101 CALL DIAGNOSTICS_FILL_FIELD( 0102 I dummyRL, dummyRL, inpFld, dummyRS, e24eb5a158 Jean*0103 I scaleFact, power, arrType, wFac, bb32d08f4a Jean*0104 I ndId, ipt, kLev, nLevs, 0105 I bibjFlg, biArg, bjArg, myThid ) 0106 ENDIF 0107 ENDIF 0108 ENDDO 0109 ENDDO 0110 0111 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0112 C-- Global/Regional Statistics : 0113 0114 C Run through list of active statistics-diagnostics to make sure 0115 C we are trying to compute & fill a valid diagnostic 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 C- Find list of regions to fill: 0124 DO j=0,nRegions 0125 region2fill(j) = diagSt_region(j,n) 0126 ENDDO 0127 C- if this diagnostics appears in several lists (with same freq) 0128 C then add regions from other lists 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 C- diagnostics is valid and Active: Now do the filling 0139 CALL DIAGSTATS_FILL( 0140 #ifdef REAL4_IS_SLOW 0141 I inpFld, dummyRL, 0142 #else 0143 I dummyRL, dummyRL, 0144 I inpFld, dummyRS, 0145 #endif 0146 I scaleFact, power, arrType, 0, 0147 I ndId, iSp, region2fill, kLev, nLevs, 0148 I bibjFlg, biArg, bjArg, myThid ) 0149 ENDIF 0150 ENDIF 0151 ENDDO 0152 ENDDO 0153 0154 RETURN 0155 END
| [ Source navigation ] | [ Diff markup ] | [ Identifier search ] | [ general search ] |
|
This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine. The LXR team |
|