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"
df9b11254f Jean*0002 #ifdef ALLOW_COST
0003 # include "COST_OPTIONS.h"
0004 #endif
9bf2145f01 Gael*0005 #ifdef ALLOW_ECCO
0006 # include "ECCO_OPTIONS.h"
0007 #endif
2dcaa8b9a5 Patr*0008
5cf4364659 Mart*0009 subroutine ctrl_unpack( first, myThid )
7109a141b2 Patr*0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
5cf4364659 Mart*0022
7109a141b2 Patr*0023
0024
0025
0026
2dcaa8b9a5 Patr*0027
7109a141b2 Patr*0028
0029
0030
0031
0032
0033
2dcaa8b9a5 Patr*0034
4c6316f049 Patr*0035
0036
7109a141b2 Patr*0037
0038
0039
0040
5cf4364659 Mart*0041 IMPLICIT NONE
2dcaa8b9a5 Patr*0042
0043
5d5c0b0d52 Patr*0044
2dcaa8b9a5 Patr*0045 #include "EEPARAMS.h"
0046 #include "SIZE.h"
0047 #include "PARAMS.h"
0048 #include "GRID.h"
5d5c0b0d52 Patr*0049
e612621177 Gael*0050 #ifdef ALLOW_CTRL
0051 # include "CTRL_SIZE.h"
5cf4364659 Mart*0052 # include "CTRL.h"
e612621177 Gael*0053 # include "CTRL_GENARR.h"
65754df434 Mart*0054 # include "OPTIMCYCLE.h"
e612621177 Gael*0055 # include "CTRL_OBCS.h"
0056 #endif
170b439592 Patr*0057 #ifdef ALLOW_COST
0058 # include "cost.h"
0059 #endif
dff4940422 Patr*0060
2dcaa8b9a5 Patr*0061
5d5c0b0d52 Patr*0062
4c6316f049 Patr*0063 logical first
5cf4364659 Mart*0064 integer myThid
2dcaa8b9a5 Patr*0065
4c6316f049 Patr*0066 #ifndef EXCLUDE_CTRL_PACK
f9d7cbfb72 Ou W*0067
0068
0069 integer ilnblnk
0070 external ilnblnk
0071
2dcaa8b9a5 Patr*0072
0073
5cf4364659 Mart*0074 integer k, ivar, iarr
4c6316f049 Patr*0075 integer ictrlgrad
9f5240b52a Jean*0076 integer cunit
0077 logical lxxadxx
5cf4364659 Mart*0078 CHARACTER*(128) cfile
0079 integer il, ilDir
0080
0081
0082
0083 INTEGER maxLocal, numLoc
0084 #ifdef READ_OLD_CTRL_PACK_FILE
0085 PARAMETER( maxLocal = old_maxcvars )
0086 #else
0087 PARAMETER( maxLocal = maxcvars )
0088 #endif
0089 INTEGER file_nvarType
0090 INTEGER file_nvarLength
0091 CHARACTER*(10) file_YctrlId
0092 INTEGER file_OptimCycle
0093 _RL file_fc
0094 INTEGER file_Ig
0095 INTEGER file_Jg
0096 INTEGER file_nSx
0097 INTEGER file_nSy
0098 INTEGER file_nWetcGlobal(Nr)
0099 INTEGER file_nWetsGlobal(Nr)
0100 INTEGER file_nWetwGlobal(Nr)
0101
0102 #ifdef ALLOW_SHELFICE
0103 INTEGER file_nWetiGlobal(Nr)
cac65437a2 Jean*0104 #endif
5cf4364659 Mart*0105 INTEGER file_varIndex(maxLocal)
0106 INTEGER file_varRecs(maxLocal)
0107 INTEGER file_varNxMax(maxLocal)
0108 INTEGER file_varNyMax(maxLocal)
0109 INTEGER file_varNrMax(maxLocal)
0110 CHARACTER*(1) file_varGrid(maxLocal)
0111 CHARACTER*(5) file_varType(maxLocal)
0112
0113 CHARACTER*(MAX_LEN_FNAM) fname_local(3)
9f5240b52a Jean*0114 #if ( defined ALLOW_GENARR2D_CONTROL || defined ALLOW_GENTIM2D_CONTROL )
0115 integer nwettmp(Nr)
5cf4364659 Mart*0116 CHARACTER*(9) mskNameForSetUnpack
9f5240b52a Jean*0117 #endif
5d5c0b0d52 Patr*0118
cf705a6c8e Mart*0119 #ifdef ALLOW_OBCS
5cf4364659 Mart*0120 INTEGER iobcs
5d5c0b0d52 Patr*0121 #ifdef ALLOW_OBCSN_CONTROL
5cf4364659 Mart*0122 INTEGER file_nWetobcsnGlo(Nr,nobcs)
5d5c0b0d52 Patr*0123 #endif
0124 #ifdef ALLOW_OBCSS_CONTROL
5cf4364659 Mart*0125 INTEGER file_nWetobcssGlo(Nr,nobcs)
5d5c0b0d52 Patr*0126 #endif
0127 #ifdef ALLOW_OBCSW_CONTROL
5cf4364659 Mart*0128 INTEGER file_nWetobcswGlo(Nr,nobcs)
5d5c0b0d52 Patr*0129 #endif
0130 #ifdef ALLOW_OBCSE_CONTROL
5cf4364659 Mart*0131 INTEGER file_nWetobcseGlo(Nr,nobcs)
5d5c0b0d52 Patr*0132 #endif
cf705a6c8e Mart*0133 #endif /* ALLOW_OBCS */
2dcaa8b9a5 Patr*0134
0135
5d5c0b0d52 Patr*0136
8f0b59c61c Patr*0137
0138 nbuffGlobal = 0
5cf4364659 Mart*0139 DO k = 1, Nr
0140 file_nWetcGlobal(k) = 0
0141 file_nWetsGlobal(k) = 0
0142 file_nWetwGlobal(k) = 0
0143
0144 ENDDO
0145 DO ivar = 1, maxLocal
0146 file_varIndex(ivar) = 0
0147 file_varRecs(ivar) = 0
0148 file_varNxMax(ivar) = 0
0149 file_varNyMax(ivar) = 0
0150 file_varNrMax(ivar) = 0
0151 file_varGrid(ivar) = ' '
0152 file_varType(ivar) = ' '
0153 ENDDO
8f0b59c61c Patr*0154
f9d7cbfb72 Ou W*0155
0156 ilDir = ilnblnk(ctrlDir)
0157
5cf4364659 Mart*0158
0159 _BEGIN_MASTER( myThid )
2dcaa8b9a5 Patr*0160
5d5c0b0d52 Patr*0161
0162
d04f98ba8f Patr*0163 if ( first ) then
0164
0165 lxxadxx = .TRUE.
4c6316f049 Patr*0166 ictrlgrad = 1
5d5c0b0d52 Patr*0167 write(cfile(1:128),'(4a,i4.4)')
5b80ef1e8d Jean*0168 & ctrlname(1:9),'_',yctrlid(1:10),
d04f98ba8f Patr*0169 & yctrlposunpack(1:4), optimcycle
6b47d550f4 Mart*0170 write(standardMessageUnit,*) 'ph-pack: unpacking ',
344ddc3242 Mart*0171 & ctrlname(1:9)
d04f98ba8f Patr*0172 else
0173
0174 lxxadxx = .FALSE.
0175 ictrlgrad = 2
0176 write(cfile(1:128),'(4a,i4.4)')
0177 & costname(1:9),'_',yctrlid(1:10),
0178 & yctrlposunpack(1:4), optimcycle
6b47d550f4 Mart*0179 write(standardMessageUnit,*) 'ph-pack: unpacking ',
344ddc3242 Mart*0180 & costname(1:9)
d04f98ba8f Patr*0181 endif
5d5c0b0d52 Patr*0182
7807741270 Gael*0183
0184 IF ( myProcId .eq. 0 ) THEN
0185
5cf4364659 Mart*0186 call mdsfindunit( cunit, myThid )
a5276edbc9 Patr*0187
0188 #ifndef ALLOW_ADMTLM
0189
5cf4364659 Mart*0190 open( cunit, file = cfile,
0191 & status = 'old',
0192 & form = 'unformatted',
0193 & access = 'sequential' )
5d5c0b0d52 Patr*0194
0195
5cf4364659 Mart*0196 read(cunit) file_nvarType
0197 read(cunit) file_nvarLength
0198 read(cunit) file_YctrlId
0199 read(cunit) file_OptimCycle
0200 read(cunit) file_fc
0201 read(cunit) file_Ig
0202 read(cunit) file_Jg
0203 read(cunit) file_nSx
0204 read(cunit) file_nSy
0205 read(cunit) (file_nWetcGlobal(k), k=1,Nr)
0206 read(cunit) (file_nWetsGlobal(k), k=1,Nr)
0207 read(cunit) (file_nWetwGlobal(k), k=1,Nr)
0208
0209
0210
7b8b86ab99 Timo*0211 #ifdef ALLOW_SHELFICE
5cf4364659 Mart*0212 read(cunit) (file_nWetiGlobal(k), k=1,Nr)
0213
1d82288286 Mart*0214 #endif
5d5c0b0d52 Patr*0215
cf705a6c8e Mart*0216 #ifdef ALLOW_OBCS
5d5c0b0d52 Patr*0217
0218 #ifdef ALLOW_OBCSN_CONTROL
5cf4364659 Mart*0219 read(cunit) ((file_nWetobcsnGlo(k,iobcs),
f9d7cbfb72 Ou W*0220 & k=1,Nr), iobcs= 1,nobcs)
5d5c0b0d52 Patr*0221 #endif
0222 #ifdef ALLOW_OBCSS_CONTROL
5cf4364659 Mart*0223 read(cunit) ((file_nWetobcssGlo(k,iobcs),
f9d7cbfb72 Ou W*0224 & k=1,Nr), iobcs= 1,nobcs)
5d5c0b0d52 Patr*0225 #endif
0226 #ifdef ALLOW_OBCSW_CONTROL
5cf4364659 Mart*0227 read(cunit) ((file_nWetobcswGlo(k,iobcs),
f9d7cbfb72 Ou W*0228 & k=1,Nr), iobcs= 1,nobcs)
5d5c0b0d52 Patr*0229 #endif
0230 #ifdef ALLOW_OBCSE_CONTROL
5cf4364659 Mart*0231 read(cunit) ((file_nWetobcseGlo(k,iobcs),
f9d7cbfb72 Ou W*0232 & k=1,Nr), iobcs= 1,nobcs)
5d5c0b0d52 Patr*0233 #endif
0234
cf705a6c8e Mart*0235 #endif /* ALLOW_OBCS */
e612621177 Gael*0236
5cf4364659 Mart*0237
5d5c0b0d52 Patr*0238
5cf4364659 Mart*0239 if ( file_nvarType .NE. nvartype ) then
0240 print *, 'ERROR: wrong nvartype ',
0241 & file_nvarType, nvartype
0242 STOP 'in S/R ctrl_unpack'
0243 endif
0244 if ( file_nvarLength .NE. nvarlength ) then
5d5c0b0d52 Patr*0245 print *, 'WARNING: wrong nvarlength ',
5cf4364659 Mart*0246 & file_nvarLength, nvarlength
5d5c0b0d52 Patr*0247 STOP 'in S/R ctrl_unpack'
5cf4364659 Mart*0248 elseif ( file_nSx .NE. nSx .OR. file_nSy .NE. nSy ) then
9f5240b52a Jean*0249 print *, 'WARNING: wrong nSx or nSy ',
5cf4364659 Mart*0250 & file_nSx, nSx, file_nSy, nSy
5d5c0b0d52 Patr*0251 STOP 'in S/R ctrl_unpack'
0252 endif
f9d7cbfb72 Ou W*0253 do k = 1, Nr
5cf4364659 Mart*0254 if ( file_nWetcGlobal(k) .NE. nWetcGlobal(k) .OR.
0255
0256 & file_nWetsGlobal(k) .NE. nWetsGlobal(k) .OR.
0257 & file_nWetwGlobal(k) .NE. nWetwGlobal(k) ) then
5d5c0b0d52 Patr*0258 print *, 'WARNING: wrong nWet?Global for k = ', k
5cf4364659 Mart*0259 print *, 'c', file_nWetcGlobal(k), nWetcGlobal(k)
0260 print *, 's', file_nWetsGlobal(k), nWetsGlobal(k)
0261 print *, 'w', file_nWetwGlobal(k), nWetwGlobal(k)
0262
5d5c0b0d52 Patr*0263 STOP
0264 endif
0265 end do
7b8b86ab99 Timo*0266 #ifdef ALLOW_SHELFICE
1d82288286 Mart*0267 do k=1,1
5cf4364659 Mart*0268 if ( file_nWetiGlobal(k) .NE. nWetiGlobal(k) ) then
1d82288286 Mart*0269 print *, 'WARNING: wrong nWetiGlobal for k = ', k
0270 STOP
0271 endif
0272 enddo
7b8b86ab99 Timo*0273 #endif /* ALLOW_SHELFICE */
5d5c0b0d52 Patr*0274
cf705a6c8e Mart*0275 #ifdef ALLOW_OBCS
5d5c0b0d52 Patr*0276
0277 #ifdef ALLOW_OBCSN_CONTROL
0278 do iobcs = 1, nobcs
f9d7cbfb72 Ou W*0279 do k = 1, Nr
5cf4364659 Mart*0280 if (file_nWetobcsnGlo(k,iobcs) .NE.
5d5c0b0d52 Patr*0281 & nWetobcsnGlo(k,iobcs)) then
0282 print *, 'WARNING: OBCSN wrong nWet?Global for k = ', k
0283 STOP
0284 endif
0285 end do
0286 end do
0287 #endif
0288 #ifdef ALLOW_OBCSS_CONTROL
0289 do iobcs = 1, nobcs
f9d7cbfb72 Ou W*0290 do k = 1, Nr
5cf4364659 Mart*0291 if (file_nWetobcssGlo(k,iobcs) .NE.
5d5c0b0d52 Patr*0292 & nWetobcssGlo(k,iobcs)) then
0293 print *, 'WARNING: OBCSS wrong nWet?Global for k = ', k
0294 STOP
0295 endif
0296 end do
0297 end do
0298 #endif
0299 #ifdef ALLOW_OBCSW_CONTROL
0300 do iobcs = 1, nobcs
f9d7cbfb72 Ou W*0301 do k = 1, Nr
5cf4364659 Mart*0302 if (file_nWetobcswGlo(k,iobcs) .NE.
5d5c0b0d52 Patr*0303 & nWetobcswGlo(k,iobcs)) then
0304 print *, 'WARNING: OBCSW wrong nWet?Global for k = ', k
0305 STOP
0306 endif
0307 end do
0308 end do
0309 #endif
0310 #ifdef ALLOW_OBCSE_CONTROL
0311 do iobcs = 1, nobcs
f9d7cbfb72 Ou W*0312 do k = 1, Nr
5cf4364659 Mart*0313 if (file_nWetobcseGlo(k,iobcs) .NE.
5d5c0b0d52 Patr*0314 & nWetobcseGlo(k,iobcs)) then
0315 print *, 'WARNING: OBCSE wrong nWet?Global for k = ', k
0316 STOP
0317 endif
0318 end do
0319 end do
0320 #endif
0321
cf705a6c8e Mart*0322 #endif /* ALLOW_OBCS */
5d5c0b0d52 Patr*0323
5cf4364659 Mart*0324
0325 numLoc = nvartype
0326 #ifdef READ_OLD_CTRL_PACK_FILE
0327 numLoc = maxLocal
0328 #endif
0329 read(cunit) ( file_varIndex(ivar), ivar=1,numLoc )
0330 read(cunit) ( file_varRecs(ivar), ivar=1,numLoc )
0331 read(cunit) ( file_varNxMax(ivar), ivar=1,numLoc )
0332 read(cunit) ( file_varNyMax(ivar), ivar=1,numLoc )
0333 read(cunit) ( file_varNrMax(ivar), ivar=1,numLoc )
0334 read(cunit) ( file_varGrid(ivar), ivar=1,numLoc )
0335 #ifdef READ_OLD_CTRL_PACK_FILE
0336 read(cunit)
0337 CALL CTRL_CONVERT_HEADER(
0338 I maxLocal, file_nvarType, errorMessageUnit,
0339 U file_varIndex, file_varRecs,
0340 U file_varNxMax, file_varNyMax, file_varNrMax,
0341 U file_varGrid, file_varType,
0342 I myThid )
0343 #else
0344 read(cunit) ( file_varType(ivar), ivar=1,numLoc )
0345 #endif
0346
a5276edbc9 Patr*0347 #endif /* ndef ALLOW_ADMTLM */
0348
23a37235f2 Gael*0349 #ifdef ALLOW_PACKUNPACK_METHOD2
7807741270 Gael*0350 ENDIF
5cf4364659 Mart*0351 _END_MASTER( myThid )
7807741270 Gael*0352 _BARRIER
23a37235f2 Gael*0353 #endif
7807741270 Gael*0354
5d5c0b0d52 Patr*0355
0356
5cf4364659 Mart*0357
0358 do ivar = 1, nvartype
0359 if ( ncvarindex(ivar) .GE. 0 ) THEN
0360 il = ilnblnk(ncvarfname(ivar))
0361 iarr = ncvarindex(ivar)
0362 call ctrl_set_fname(ctrlDir(1:ilDir)//ncvarfname(ivar),
0363 & fname_local, myThid )
0364 if ( ncvargrd(ivar).EQ.'m' ) then
cf705a6c8e Mart*0365 #ifdef ALLOW_OBCS
5cf4364659 Mart*0366 if ( iarr.EQ.1 ) then
0367 # ifdef ALLOW_OBCSN_CONTROL
0368 call ctrl_set_unpack_xz( cunit, ivar, fname_local(ictrlgrad),
0369 & 'maskobcsn', 'wobcsn', wobcsn, nWetobcsnGlo, myThid )
0370 # endif
0371 elseif ( iarr.EQ.2 ) then
0372 # ifdef ALLOW_OBCSS_CONTROL
0373 call ctrl_set_unpack_xz( cunit, ivar, fname_local(ictrlgrad),
0374 & 'maskobcss', 'wobcss', wobcss, nWetobcssGlo, myThid )
0375 # endif
0376 elseif ( iarr.EQ.3 ) then
0377 # ifdef ALLOW_OBCSE_CONTROL
0378 call ctrl_set_unpack_yz( cunit, ivar, fname_local(ictrlgrad),
0379 & 'maskobcse', 'wobcse', wobcse, nWetobcseGlo, myThid )
0380 # endif
0381 elseif ( iarr.EQ.4 ) then
0382 # ifdef ALLOW_OBCSW_CONTROL
0383 call ctrl_set_unpack_yz( cunit, ivar, fname_local(ictrlgrad),
0384 & 'maskobcsw', 'wobcsw', wobcsw, nWetobcswGlo, myThid )
0385 # endif
0386 endif
cf705a6c8e Mart*0387 #endif /* ALLOW_OBCS */
61a813cf9a Gael*0388
e901366860 Patr*0389 #ifdef ALLOW_GENARR2D_CONTROL
5cf4364659 Mart*0390 elseif ( ncvartype(ivar).EQ.'Arr2D' ) then
0391 if ( xx_genarr2d_weight(iarr).NE.' ') then
0392 mskNameForSetUnpack='maskCtrlC'
44d3986245 Jean*0393 DO k=1,Nr
5cf4364659 Mart*0394 nwettmp(k) = nwetcglobal(k)
44d3986245 Jean*0395 ENDDO
5cf4364659 Mart*0396 # ifdef ALLOW_SHELFICE
0397 if ( ncvargrd(ivar).EQ.'i' ) then
0398 mskNameForSetUnpack='maskCtrlI'
0399 DO k=1,Nr
0400 nwettmp(k) = nwetiglobal(k)
0401 ENDDO
0402 endif
7b8b86ab99 Timo*0403 # endif
96576598bf Jean*0404 call ctrl_set_unpack_xy(
5cf4364659 Mart*0405 & lxxadxx, cunit, ivar, genarr2dPrecond(iarr),
7b8b86ab99 Timo*0406 & fname_local(ictrlgrad), mskNameForSetUnpack,
96576598bf Jean*0407 & xx_genarr2d_weight(iarr),
5cf4364659 Mart*0408 & nwettmp, myThid )
0409 endif
9f5240b52a Jean*0410 #endif /* ALLOW_GENARR2D_CONTROL */
e901366860 Patr*0411
0412 #ifdef ALLOW_GENARR3D_CONTROL
5cf4364659 Mart*0413 elseif ( ncvartype(ivar).EQ.'Arr3D' ) then
0414 if ( xx_genarr3d_weight(iarr).NE.' ') then
0415 call ctrl_set_unpack_xyz( lxxadxx, cunit, ivar,
de57a2ec4b Mart*0416 & fname_local(ictrlgrad), 'maskCtrlC',
96576598bf Jean*0417 & xx_genarr3d_weight(iarr),
5cf4364659 Mart*0418 & wunit, nwetcglobal, myThid )
0419 endif
9f5240b52a Jean*0420 #endif /* ALLOW_GENARR3D_CONTROL */
e901366860 Patr*0421
7bd66d7dc3 Patr*0422 #ifdef ALLOW_GENTIM2D_CONTROL
5cf4364659 Mart*0423 elseif ( ncvartype(ivar).EQ.'Tim2D' ) then
0424 if ( xx_gentim2d_weight(iarr).NE.' ') then
0425 mskNameForSetUnpack='maskCtrlC'
0426 DO k=1,Nr
44d3986245 Jean*0427 nwettmp(k) = nwetcglobal(k)
5cf4364659 Mart*0428 ENDDO
7b8b86ab99 Timo*0429 # ifdef ALLOW_SHELFICE
5cf4364659 Mart*0430 if ( ncvargrd(ivar).EQ.'i' ) then
44d3986245 Jean*0431 mskNameForSetUnpack='maskCtrlI'
0432 DO k=1,Nr
5cf4364659 Mart*0433 nwettmp(k) = nwetiglobal(k)
44d3986245 Jean*0434 ENDDO
5cf4364659 Mart*0435 endif
7b8b86ab99 Timo*0436 # endif
96576598bf Jean*0437 call ctrl_set_unpack_xy(
5cf4364659 Mart*0438 & lxxadxx, cunit, ivar, gentim2dPrecond(iarr),
7b8b86ab99 Timo*0439 & fname_local(ictrlgrad), mskNameForSetUnpack,
96576598bf Jean*0440 & xx_gentim2d_weight(iarr),
5cf4364659 Mart*0441 & nwettmp, myThid )
0442 endif
9f5240b52a Jean*0443 #endif /* ALLOW_GENTIM2D_CONTROL */
5cf4364659 Mart*0444 endif
0445
0446 endif
0447
0448 enddo
7bd66d7dc3 Patr*0449
23a37235f2 Gael*0450 #ifdef ALLOW_PACKUNPACK_METHOD2
5cf4364659 Mart*0451 _BEGIN_MASTER( myThid )
7807741270 Gael*0452 IF ( myProcId .eq. 0 ) THEN
0453 #endif
0454
0455 close ( cunit )
5b80ef1e8d Jean*0456 ENDIF
5cf4364659 Mart*0457 _END_MASTER( myThid )
7807741270 Gael*0458 _BARRIER
4c6316f049 Patr*0459 #endif /* EXCLUDE_CTRL_PACK */
0460
5cf4364659 Mart*0461 RETURN
0462 END