File indexing completed on 2024-03-02 06:10:21 UTC
view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 UTC
7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
7109a141b2 Patr*0002
4d72283393 Mart*0003 subroutine ctrl_Summary( myThid )
7109a141b2 Patr*0004
0005
0006
0007
0008
219393e304 Gael*0009
7109a141b2 Patr*0010
0011
0012
0013
0014
5cf4364659 Mart*0015 IMPLICIT NONE
7109a141b2 Patr*0016
0017
0018
0019 #include "EEPARAMS.h"
0020 #include "SIZE.h"
6b47d550f4 Mart*0021 #include "PARAMS.h"
7109a141b2 Patr*0022
dff4940422 Patr*0023 #ifdef ALLOW_CAL
7109a141b2 Patr*0024 # include "cal.h"
0025 #endif
b6f5c14800 Gael*0026 #ifdef ALLOW_AUTODIFF
0027 # include "AUTODIFF_PARAMS.h"
0028 #endif
ea1c7c7217 Gael*0029 #ifdef ALLOW_CTRL
0030 # include "CTRL_SIZE.h"
5cf4364659 Mart*0031 # include "CTRL.h"
0032 # if ( defined ALLOW_GENARR2D_CONTROL \
0033 || defined ALLOW_GENARR3D_CONTROL \
0034 || defined ALLOW_GENTIM2D_CONTROL )
ea1c7c7217 Gael*0035 # include "CTRL_GENARR.h"
0036 # endif
0037 #endif
7109a141b2 Patr*0038
0039
4d72283393 Mart*0040 integer myThid
7109a141b2 Patr*0041
9f5240b52a Jean*0042
0043 integer ilnblnk
0044 external ilnblnk
7109a141b2 Patr*0045
9f5240b52a Jean*0046
7109a141b2 Patr*0047 integer bi,bj
9f5240b52a Jean*0048 integer k
5cf4364659 Mart*0049 integer ivar
7109a141b2 Patr*0050 integer il
5cf4364659 Mart*0051 integer errCount
7109a141b2 Patr*0052 integer nwetcenter
0053 integer nwetsouth
0054 integer nwetwest
0055
0056 character*(max_len_mbuf) msgbuf
0057
cf705a6c8e Mart*0058 #if (defined (ALLOW_GENARR2D_CONTROL) \
0059 || defined (ALLOW_GENARR3D_CONTROL) \
0060 || defined (ALLOW_GENTIM2D_CONTROL))
5cf4364659 Mart*0061 INTEGER iarr, jarr, iw
ea1c7c7217 Gael*0062 #endif
cf705a6c8e Mart*0063 #if ( defined ALLOW_GENTIM2D_CONTROL && defined ALLOW_CAL )
9f5240b52a Jean*0064 integer i, timeint(4)
0065 #endif
7109a141b2 Patr*0066
0067
0068
5cf4364659 Mart*0069 errCount = 0
0070
0071 write(msgbuf,'(a)') ' '
4d72283393 Mart*0072 call print_message( msgbuf, standardMessageUnit,
0073 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0074 write(msgbuf,'(a)')
0075 &'// ======================================================='
4d72283393 Mart*0076 call print_message( msgbuf, standardMessageUnit,
0077 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0078 write(msgbuf,'(a)')
219393e304 Gael*0079 &'// control vector configuration >>> START <<<'
4d72283393 Mart*0080 call print_message( msgbuf, standardMessageUnit,
0081 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0082 write(msgbuf,'(a)')
0083 &'// ======================================================='
4d72283393 Mart*0084 call print_message( msgbuf, standardMessageUnit,
0085 & SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0086 write(msgbuf,'(a)') ' '
4d72283393 Mart*0087 call print_message( msgbuf, standardMessageUnit,
0088 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0089
0090 write(msgbuf,'(a)')
0091 &' Total number of ocean points per tile:'
4d72283393 Mart*0092 call print_message( msgbuf, standardMessageUnit,
0093 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0094 write(msgbuf,'(a)')
0095 &' --------------------------------------'
4d72283393 Mart*0096 call print_message( msgbuf, standardMessageUnit,
0097 & SQUEEZE_RIGHT, myThid )
0098 write(msgbuf,'(a,i8)') ' sNx*sNy*Nr = ',sNx*sNy*Nr
0099 call print_message( msgbuf, standardMessageUnit,
0100 & SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0101 write(msgbuf,'(a)') ' '
4d72283393 Mart*0102 call print_message( msgbuf, standardMessageUnit,
0103 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0104 write(msgbuf,'(a)')
0105 &' Number of ocean points per tile:'
4d72283393 Mart*0106 call print_message( msgbuf, standardMessageUnit,
0107 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0108 write(msgbuf,'(a)')
0109 &' --------------------------------'
4d72283393 Mart*0110 call print_message( msgbuf, standardMessageUnit,
0111 & SQUEEZE_RIGHT, myThid )
0112 do bj = 1,nSy
0113 do bi = 1,nSx
7109a141b2 Patr*0114 nwetcenter = 0
0115 nwetsouth = 0
0116 nwetwest = 0
4d72283393 Mart*0117 do k = 1,Nr
7109a141b2 Patr*0118 nwetcenter = nwetcenter + nwetctile(bi,bj,k)
0119 nwetsouth = nwetsouth + nwetstile(bi,bj,k)
0120 nwetwest = nwetwest + nwetwtile(bi,bj,k)
0121 enddo
5cf4364659 Mart*0122
0123 write(msgbuf,'(a,i4.3,i4.3,i8,i8,i8)')
0124 & ' bi,bj,#(c/s/w):',bi,bj,nwetcenter, nwetsouth, nwetwest
4d72283393 Mart*0125 call print_message( msgbuf, standardMessageUnit,
0126 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0127 enddo
0128 enddo
0129
5cf4364659 Mart*0130 do ivar = 1, maxcvars
0131
0132
0133 if ( ncvarindex(ivar) .GE. 0 ) then
ea1c7c7217 Gael*0134
5cf4364659 Mart*0135 write(msgbuf,'(a)') ' '
4d72283393 Mart*0136 call print_message( msgbuf, standardMessageUnit,
0137 & SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0138 il = ILNBLNK( ncvarfname(ivar) )
0139
0140 #ifdef ALLOW_GENARR3D_CONTROL
0141 if ( ncvartype(ivar) .eq. 'Arr3D') then
0142 iarr = ncvarindex(ivar)
0143 if ( xx_genarr3d_file(iarr) .eq. ncvarfname(ivar) ) then
0144 write(msgbuf,'(a,i3,a)')
0145 & ' -> 3d control, genarr3d no.',iarr,' is in use'
4d72283393 Mart*0146 call print_message( msgbuf, standardMessageUnit,
0147 & SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0148 else
0149 write(msgbuf,'(a,i6)')
0150 & ' -> something is wrong with 3d control, genarr3d no.',iarr
0151 call print_error( msgbuf, myThid )
0152 errCount = errCount + 1
6b47d550f4 Mart*0153 endif
5cf4364659 Mart*0154 endif
ea1c7c7217 Gael*0155 #endif
5cf4364659 Mart*0156 #ifdef ALLOW_GENARR2D_CONTROL
0157 if ( ncvartype(ivar) .eq. 'Arr2D') then
0158 iarr = ncvarindex(ivar)
0159 if ( xx_genarr2d_file(iarr) .eq. ncvarfname(ivar) ) then
0160 write(msgbuf,'(a,i3,a)')
0161 & ' -> 2d control, genarr2d no.',iarr,' is in use'
4d72283393 Mart*0162 call print_message( msgbuf, standardMessageUnit,
0163 & SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0164 else
0165 write(msgbuf,'(a,i6)')
0166 & ' -> something is wrong with 2d control, genarr2d no.',iarr
0167 call print_error( msgbuf, myThid )
0168 errCount = errCount + 1
6b47d550f4 Mart*0169 endif
5cf4364659 Mart*0170 endif
ea1c7c7217 Gael*0171 #endif
0172 #ifdef ALLOW_GENTIM2D_CONTROL
5cf4364659 Mart*0173 if ( ncvartype(ivar) .eq. 'Tim2D') then
0174 iarr = ncvarindex(ivar)
0175 if ( xx_gentim2d_file(iarr) .eq. ncvarfname(ivar) ) then
0176 write(msgbuf,'(2a,i3,a)') ' -> ',
0177 & 'time variable 2d control, gentim2d no.',iarr,' is in use'
0178 call print_message( msgbuf, standardMessageUnit,
0179 & SQUEEZE_RIGHT, myThid )
0180 else
0181 write(msgbuf,'(2a,i6)') ' -> something is wrong with ',
0182 & 'time variable 2d control, gentim2d no.',iarr
0183 call print_error( msgbuf, myThid )
0184 errCount = errCount + 1
0185 endif
0186 endif
0187 #endif
ea1c7c7217 Gael*0188 write(msgbuf,'(a,a)')
5cf4364659 Mart*0189 &' file = ',ncvarfname(ivar)(1:il)
4d72283393 Mart*0190 call print_message( msgbuf, standardMessageUnit,
0191 & SQUEEZE_RIGHT, myThid )
ea1c7c7217 Gael*0192 write(msgbuf,'(a,a)')
5cf4364659 Mart*0193 &' ncvartype = ', ncvartype(ivar)
4d72283393 Mart*0194 call print_message( msgbuf, standardMessageUnit,
0195 & SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0196 write(msgbuf,'(a,i5,a)')
0197 &' index = ', ivar, ' (use this for pkg/grdchk)'
4d72283393 Mart*0198 call print_message( msgbuf, standardMessageUnit,
0199 & SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0200 write(msgbuf,'(a,i5)')
0201 &' ncvarindex = ', ncvarindex(ivar)
4d72283393 Mart*0202 call print_message( msgbuf, standardMessageUnit,
0203 & SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0204
0205 #ifdef ALLOW_GENARR3D_CONTROL
0206 if ( ncvartype(ivar) .eq. 'Arr3D') then
0207 iarr = ncvarindex(ivar)
0208 iw = ILNBLNK( xx_genarr3d_weight(iarr) )
0209 write(msgbuf,'(a,a)')
0210 &' weight = ',xx_genarr3d_weight(iarr)(1:iw)
4d72283393 Mart*0211 call print_message( msgbuf, standardMessageUnit,
0212 & SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0213 do jarr=1,maxCtrlProc
0214 if (xx_genarr3d_preproc(jarr,iarr).NE.' ') then
0215 il = ilnblnk(xx_genarr3d_preproc(jarr,iarr))
0216 write(msgbuf,'(a,a)') ' preprocess = ',
0217 & xx_genarr3d_preproc(jarr,iarr)(1:il)
4d72283393 Mart*0218 call print_message( msgbuf, standardMessageUnit,
0219 & SQUEEZE_RIGHT, myThid )
513e004a84 Gael*0220 endif
5cf4364659 Mart*0221 enddo
0222 endif
0223 #endif
0224 #ifdef ALLOW_GENARR2D_CONTROL
0225 if ( ncvartype(ivar) .eq. 'Arr2D' ) then
0226 iarr = ncvarindex(ivar)
0227 iw = ILNBLNK( xx_genarr2d_weight(iarr) )
0228 write(msgbuf,'(a,a)')
0229 &' weight = ',xx_genarr2d_weight(iarr)(1:iw)
0230 call print_message( msgbuf, standardMessageUnit,
0231 & SQUEEZE_RIGHT, myThid )
0232 do jarr=1,maxCtrlProc
0233 if (xx_genarr2d_preproc(jarr,iarr).NE.' ') then
0234 il = ilnblnk(xx_genarr2d_preproc(jarr,iarr))
0235 write(msgbuf,'(a,a)') ' preprocess = ',
0236 & xx_genarr2d_preproc(jarr,iarr)(1:il)
4d72283393 Mart*0237 call print_message( msgbuf, standardMessageUnit,
0238 & SQUEEZE_RIGHT, myThid )
4d1f3cfa6a Gael*0239 endif
5cf4364659 Mart*0240 enddo
0241 endif
0242 #endif
0243 #ifdef ALLOW_GENTIM2D_CONTROL
0244 if ( ncvartype(ivar) .eq. 'Tim2D' ) then
0245 iarr = ncvarindex(ivar)
0246 iw = ILNBLNK( xx_gentim2d_weight(iarr) )
0247 write(msgbuf,'(a,a)')
0248 &' weight = ',xx_gentim2d_weight(iarr)(1:iw)
0249 call print_message( msgbuf, standardMessageUnit,
0250 & SQUEEZE_RIGHT, myThid )
0251 #ifdef ALLOW_CAL
0252 if ( useCAL ) then
0253 call cal_TimeInterval( xx_gentim2d_period(iarr),
0254 & 'secs', timeint, myThid )
0255 write(msgbuf,'(a,i9.8,i7.6)')
0256 &' period = ',(timeint(i), i=1,2)
0257 call print_message( msgbuf, standardMessageUnit,
0258 & SQUEEZE_RIGHT, myThid )
0259 endif
0260 #endif
0261
0262 do jarr=1,maxCtrlProc
0263 if (xx_gentim2d_preproc(jarr,iarr).NE.' ') then
0264 il = ilnblnk(xx_gentim2d_preproc(jarr,iarr))
0265 write(msgbuf,'(a,a)') ' preprocess = ',
0266 & xx_gentim2d_preproc(jarr,iarr)(1:il)
4d72283393 Mart*0267 call print_message( msgbuf, standardMessageUnit,
0268 & SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0269
0270 if (xx_gentim2d_preproc_c(jarr,iarr).NE.' ') then
0271 il = ilnblnk(xx_gentim2d_preproc_c(jarr,iarr))
0272 write(msgbuf,'(a,a)') ' param. (text)= ',
0273 & xx_gentim2d_preproc_c(jarr,iarr)(1:il)
0274 call print_message( msgbuf, standardMessageUnit,
0275 & SQUEEZE_RIGHT, myThid )
0276 endif
0277
0278 if (xx_gentim2d_preproc_i(jarr,iarr).NE.0) then
0279 write(msgbuf,'(a,i6)') ' param. (int.)= ',
0280 & xx_gentim2d_preproc_i(jarr,iarr)
0281 call print_message( msgbuf, standardMessageUnit,
0282 & SQUEEZE_RIGHT, myThid )
0283 endif
0284
0285 if (xx_gentim2d_preproc_r(jarr,iarr).NE.0. _d 0) then
0286 write(msgbuf,'(a,e10.3)') ' param. (real)= ',
0287 & xx_gentim2d_preproc_r(jarr,iarr)
0288 call print_message( msgbuf, standardMessageUnit,
0289 & SQUEEZE_RIGHT, myThid )
0290 endif
513e004a84 Gael*0291
5cf4364659 Mart*0292 endif
0293 enddo
0294 endif
0295 #endif
ea1c7c7217 Gael*0296 endif
0297 enddo
0298
5cf4364659 Mart*0299 if ( errCount.GE.1 ) then
0300 write(msgbuf,'(a,i3,a)')
0301 & 'ctrl_summary: detected', errCount,' fatal error(s)'
0302 call print_error( msgbuf, myThid )
0303 stop 'ABNORMAL END: S/R CTRL_SUMMARY'
0304 endif
b6f5c14800 Gael*0305
5cf4364659 Mart*0306 write(msgbuf,'(a)') ' '
4d72283393 Mart*0307 call print_message( msgbuf, standardMessageUnit,
0308 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0309 write(msgbuf,'(a)')
0310 &'// ======================================================='
4d72283393 Mart*0311 call print_message( msgbuf, standardMessageUnit,
0312 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0313 write(msgbuf,'(a)')
219393e304 Gael*0314 &'// control vector configuration >>> END <<<'
4d72283393 Mart*0315 call print_message( msgbuf, standardMessageUnit,
0316 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0317 write(msgbuf,'(a)')
0318 &'// ======================================================='
4d72283393 Mart*0319 call print_message( msgbuf, standardMessageUnit,
0320 & SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0321 write(msgbuf,'(a)') ' '
4d72283393 Mart*0322 call print_message( msgbuf, standardMessageUnit,
0323 & SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0324
0325 return
0326 end