File indexing completed on 2024-03-02 06:10:19 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
4c6316f049 Patr*0009 subroutine ctrl_pack( first, mythid )
7109a141b2 Patr*0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
5cf4364659 Mart*0022
5b80ef1e8d Jean*0023
7109a141b2 Patr*0024
0025
0026
0027
0028
0029
0030
dff4940422 Patr*0031
4c6316f049 Patr*0032
7109a141b2 Patr*0033
0034
0035
0036
5cf4364659 Mart*0037 IMPLICIT NONE
2dcaa8b9a5 Patr*0038
0039
5d5c0b0d52 Patr*0040
2dcaa8b9a5 Patr*0041 #include "EEPARAMS.h"
0042 #include "SIZE.h"
0043 #include "PARAMS.h"
0044 #include "GRID.h"
5d5c0b0d52 Patr*0045
e612621177 Gael*0046 #ifdef ALLOW_CTRL
0047 # include "CTRL_SIZE.h"
5cf4364659 Mart*0048 # include "CTRL.h"
e612621177 Gael*0049 # include "CTRL_GENARR.h"
65754df434 Mart*0050 # include "OPTIMCYCLE.h"
e612621177 Gael*0051 # include "CTRL_OBCS.h"
0052 #endif
170b439592 Patr*0053 #ifdef ALLOW_COST
0054 # include "cost.h"
0055 #endif
dff4940422 Patr*0056
2dcaa8b9a5 Patr*0057
4c6316f049 Patr*0058 logical first
2dcaa8b9a5 Patr*0059 integer mythid
0060
4c6316f049 Patr*0061 #ifndef EXCLUDE_CTRL_PACK
f9d7cbfb72 Ou W*0062
0063
0064 integer ilnblnk
0065 external ilnblnk
0066
2dcaa8b9a5 Patr*0067
0068
9f5240b52a Jean*0069 logical doglobalread
0070 logical ladinit
0071 logical lxxadxx
4c6316f049 Patr*0072
5cf4364659 Mart*0073 integer k, ivar, iarr
9f5240b52a Jean*0074 integer cunit
0075 integer ictrlgrad
0076 _RL fcloc
0077
0078 character*(128) cfile
5cf4364659 Mart*0079 integer il, ilDir
9f5240b52a Jean*0080
de57a2ec4b Mart*0081 character*(MAX_LEN_FNAM) fname_local(3)
5cf4364659 Mart*0082
9f5240b52a Jean*0083 #if ( defined ALLOW_GENARR2D_CONTROL || defined ALLOW_GENTIM2D_CONTROL )
0084
5cf4364659 Mart*0085 character*(9) mskNameForSetPack
0086 #endif
0087
0088 #ifdef ALLOW_OBCS
0089 integer iobcs
9f5240b52a Jean*0090 #endif
2dcaa8b9a5 Patr*0091
0092
0093
0094
0095 doglobalread = .false.
0096
0097
0098 ladinit = .false.
0099
8f0b59c61c Patr*0100
0101 nbuffglobal = 0
0102
37e373688b Mart*0103
0104 fcloc = zeroRL
0105
f9d7cbfb72 Ou W*0106
0107 ilDir = ilnblnk(ctrlDir)
0108
45913d6a59 Patr*0109
2dcaa8b9a5 Patr*0110 _BEGIN_MASTER( mythid )
0111
d04f98ba8f Patr*0112 if ( first ) then
4c6316f049 Patr*0113
0114 lxxadxx = .TRUE.
0115 ictrlgrad = 1
37e373688b Mart*0116 fcloc = zeroRL
4c6316f049 Patr*0117 write(cfile(1:128),'(4a,i4.4)')
5b80ef1e8d Jean*0118 & ctrlname(1:9),'_',yctrlid(1:10),
d04f98ba8f Patr*0119 & yctrlpospack, optimcycle
344ddc3242 Mart*0120 write(standardMessageUnit,*) 'ph-pack: packing ',ctrlname(1:9)
4c6316f049 Patr*0121 else
2dcaa8b9a5 Patr*0122
4c6316f049 Patr*0123 lxxadxx = .FALSE.
0124 ictrlgrad = 2
c433ed6869 Gael*0125 #ifdef ALLOW_COST
0126 # ifdef ALLOW_OPENAD
60e3924f90 Patr*0127 fcloc = fc%v
c433ed6869 Gael*0128 # else
4c6316f049 Patr*0129 fcloc = fc
c433ed6869 Gael*0130 # endif
60e3924f90 Patr*0131 #endif
5d5c0b0d52 Patr*0132 write(cfile(1:128),'(4a,i4.4)')
5b80ef1e8d Jean*0133 & costname(1:9),'_',yctrlid(1:10),
d04f98ba8f Patr*0134 & yctrlpospack, optimcycle
344ddc3242 Mart*0135 write(standardMessageUnit,*) 'ph-pack: packing ',costname(1:9)
4c6316f049 Patr*0136 endif
2dcaa8b9a5 Patr*0137
7807741270 Gael*0138
0139 IF ( myProcId .eq. 0 ) THEN
0140
4c6316f049 Patr*0141 call mdsfindunit( cunit, mythid )
0142 open( cunit, file = cfile,
0143 & status = 'unknown',
0144 & form = 'unformatted',
0145 & access = 'sequential' )
2dcaa8b9a5 Patr*0146
0147
5a356b90da Mart*0148 write(cunit) nvartype
0149 write(cunit) nvarlength
0150 write(cunit) yctrlid
0151 write(cunit) optimCycle
37e373688b Mart*0152 write(cunit) fcloc
5a356b90da Mart*0153
0154 write(cunit) 1
0155
0156 write(cunit) 1
f9d7cbfb72 Ou W*0157 write(cunit) nSx
0158 write(cunit) nSy
0159 write(cunit) (nWetcGlobal(k), k=1,Nr)
0160 write(cunit) (nWetsGlobal(k), k=1,Nr)
0161 write(cunit) (nWetwGlobal(k), k=1,Nr)
5cf4364659 Mart*0162
0163
0164
7b8b86ab99 Timo*0165 #ifdef ALLOW_SHELFICE
f9d7cbfb72 Ou W*0166 write(cunit) (nWetiGlobal(k), k=1,Nr)
1d82288286 Mart*0167
0168 #endif
4c6316f049 Patr*0169
cf705a6c8e Mart*0170 #ifdef ALLOW_OBCS
5cf4364659 Mart*0171 # ifdef ALLOW_OBCSN_CONTROL
f9d7cbfb72 Ou W*0172 write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,Nr),iobcs= 1,nobcs)
5cf4364659 Mart*0173 # endif
0174 # ifdef ALLOW_OBCSS_CONTROL
f9d7cbfb72 Ou W*0175 write(cunit) ((nWetobcssGlo(k,iobcs), k=1,Nr),iobcs= 1,nobcs)
5cf4364659 Mart*0176 # endif
0177 # ifdef ALLOW_OBCSW_CONTROL
f9d7cbfb72 Ou W*0178 write(cunit) ((nWetobcswGlo(k,iobcs), k=1,Nr),iobcs= 1,nobcs)
5cf4364659 Mart*0179 # endif
0180 # ifdef ALLOW_OBCSE_CONTROL
f9d7cbfb72 Ou W*0181 write(cunit) ((nWetobcseGlo(k,iobcs), k=1,Nr),iobcs= 1,nobcs)
5cf4364659 Mart*0182 # endif
cf705a6c8e Mart*0183 #endif
e612621177 Gael*0184
5cf4364659 Mart*0185 write(cunit) (ncvarindex(ivar), ivar=1,nvartype)
0186 write(cunit) (ncvarrecs(ivar), ivar=1,nvartype)
0187 write(cunit) (ncvarxmax(ivar), ivar=1,nvartype)
0188 write(cunit) (ncvarymax(ivar), ivar=1,nvartype)
0189 write(cunit) (ncvarnrmax(ivar), ivar=1,nvartype)
0190 write(cunit) (ncvargrd(ivar), ivar=1,nvartype)
0191 write(cunit) (ncvartype(ivar), ivar=1,nvartype)
2dcaa8b9a5 Patr*0192
23a37235f2 Gael*0193 #ifdef ALLOW_PACKUNPACK_METHOD2
7807741270 Gael*0194 ENDIF
0195 _END_MASTER( mythid )
0196 _BARRIER
0197 #endif
0198
5cf4364659 Mart*0199
0200 do ivar = 1, nvartype
0201 if ( ncvarindex(ivar) .GE. 0 ) THEN
0202 il = ilnblnk(ncvarfname(ivar))
0203 iarr = ncvarindex(ivar)
0204 call ctrl_set_fname(ctrlDir(1:ilDir)//ncvarfname(ivar),
0205 & fname_local, mythid )
0206 if ( ncvargrd(ivar).EQ.'m' ) then
cf705a6c8e Mart*0207 #ifdef ALLOW_OBCS
5cf4364659 Mart*0208 if ( iarr.EQ.1 ) then
0209 # ifdef ALLOW_OBCSN_CONTROL
0210 call ctrl_set_pack_xz( cunit, ivar, fname_local(ictrlgrad),
0211 & 'maskobcsn', 'wobcsn', wobcsn, lxxadxx, mythid )
0212 # endif
0213 elseif ( iarr.EQ.2 ) then
0214 # ifdef ALLOW_OBCSS_CONTROL
0215 call ctrl_set_pack_xz( cunit, ivar, fname_local(ictrlgrad),
0216 & 'maskobcss', 'wobcss', wobcss, lxxadxx, mythid )
0217 # endif
0218 elseif ( iarr.EQ.3 ) then
0219 # ifdef ALLOW_OBCSE_CONTROL
0220 call ctrl_set_pack_yz( cunit, ivar, fname_local(ictrlgrad),
0221 & 'maskobcse', 'wobcse', wobcse, lxxadxx, mythid )
0222 # endif
0223 elseif ( iarr.EQ.4 ) then
0224 # ifdef ALLOW_OBCSW_CONTROL
0225 call ctrl_set_pack_yz( cunit, ivar, fname_local(ictrlgrad),
0226 & 'maskobcsw', 'wobcsw', wobcsw, lxxadxx, mythid )
0227 # endif
0228 endif
cf705a6c8e Mart*0229 #endif /* ALLOW_OBCS */
61a813cf9a Gael*0230
e901366860 Patr*0231 #ifdef ALLOW_GENARR2D_CONTROL
5cf4364659 Mart*0232 elseif ( ncvartype(ivar).EQ.'Arr2D' ) then
0233 if ( xx_genarr2d_weight(iarr).NE.' ') then
0234 mskNameForSetPack='maskCtrlC'
7b8b86ab99 Timo*0235 # ifdef ALLOW_SHELFICE
5cf4364659 Mart*0236 if ( ncvargrd(ivar).EQ.'i' ) mskNameForSetPack='maskCtrlI'
7b8b86ab99 Timo*0237 # endif
e901366860 Patr*0238 call ctrl_set_pack_xy(
5cf4364659 Mart*0239 & cunit, ivar, genarr2dPrecond(iarr),
7b8b86ab99 Timo*0240 & fname_local(ictrlgrad), mskNameForSetPack,
df9b11254f Jean*0241 & xx_genarr2d_weight(iarr),
5cf4364659 Mart*0242 & lxxadxx, mythid )
0243 endif
9f5240b52a Jean*0244 #endif /* ALLOW_GENARR2D_CONTROL */
e901366860 Patr*0245
0246 #ifdef ALLOW_GENARR3D_CONTROL
5cf4364659 Mart*0247 elseif ( ncvartype(ivar).EQ.'Arr3D' ) then
0248 if ( xx_genarr3d_weight(iarr).NE.' ') then
e901366860 Patr*0249 call ctrl_set_pack_xyz(
5cf4364659 Mart*0250 & cunit, ivar, fname_local(ictrlgrad), 'maskCtrlC',
df9b11254f Jean*0251 & xx_genarr3d_weight(iarr),
5cf4364659 Mart*0252 & wunit, lxxadxx, mythid )
0253 endif
9f5240b52a Jean*0254 #endif /* ALLOW_GENARR3D_CONTROL */
e901366860 Patr*0255
7bd66d7dc3 Patr*0256 #ifdef ALLOW_GENTIM2D_CONTROL
5cf4364659 Mart*0257 elseif ( ncvartype(ivar).EQ.'Tim2D' ) then
0258 if ( xx_gentim2d_weight(iarr).NE.' ') then
0259 mskNameForSetPack='maskCtrlC'
7b8b86ab99 Timo*0260 # ifdef ALLOW_SHELFICE
5cf4364659 Mart*0261 if ( ncvargrd(ivar).EQ.'i' ) mskNameForSetPack='maskCtrlI'
7b8b86ab99 Timo*0262 # endif
7bd66d7dc3 Patr*0263 call ctrl_set_pack_xy(
5cf4364659 Mart*0264 & cunit, ivar, gentim2dPrecond(iarr),
7b8b86ab99 Timo*0265 & fname_local(ictrlgrad), mskNameForSetPack,
df9b11254f Jean*0266 & xx_gentim2d_weight(iarr),
5cf4364659 Mart*0267 & lxxadxx, mythid )
0268 endif
9f5240b52a Jean*0269 #endif /* ALLOW_GENTIM2D_CONTROL */
5cf4364659 Mart*0270 endif
0271
0272 endif
0273
0274 enddo
7bd66d7dc3 Patr*0275
23a37235f2 Gael*0276 #ifdef ALLOW_PACKUNPACK_METHOD2
7807741270 Gael*0277 _BEGIN_MASTER( mythid )
0278 IF ( myProcId .eq. 0 ) THEN
0279 #endif
5d5c0b0d52 Patr*0280
7807741270 Gael*0281 close ( cunit )
5b80ef1e8d Jean*0282 ENDIF
7807741270 Gael*0283 _END_MASTER( mythid )
0284 _BARRIER
4c6316f049 Patr*0285 #endif /* EXCLUDE_CTRL_PACK */
0286
2dcaa8b9a5 Patr*0287 return
0288 end