[12080] | 1 | !---------------------------------------------------------------------- |
---|
| 2 | ! MERCATOR OCEAN, System and Interface for oceanic RElocable Nesting |
---|
| 3 | !---------------------------------------------------------------------- |
---|
| 4 | !> @file |
---|
| 5 | !> @brief |
---|
| 6 | !> This program add line to all variables of the input file. |
---|
| 7 | !> |
---|
| 8 | !> @details |
---|
| 9 | !> @section sec2 how to |
---|
| 10 | !> to add line to file:<br/> |
---|
| 11 | !> @code{.sh} |
---|
| 12 | !> ./SIREN/bin/addline addline.nam |
---|
| 13 | !> @endcode |
---|
| 14 | !> the namelist file (**addline.nam**) sets up program parameters. |
---|
| 15 | !> |
---|
| 16 | !> to set up program parameters, you just have to fill the namelist file (**add_line.nam**). |
---|
| 17 | !> @note |
---|
| 18 | !> you could find a template of the namelist in templates directory. |
---|
| 19 | !> |
---|
| 20 | !> create_bathy.nam comprise 4 namelists:<br/> |
---|
| 21 | !> - **namlog** to set logger parameters |
---|
| 22 | !> - **namcfg** to set configuration file parameters |
---|
| 23 | !> - **namsrc** to set source grid parameters |
---|
| 24 | !> - **namout** to set output parameters |
---|
| 25 | !> |
---|
| 26 | !> here after, each sub-namelist parameters is detailed. |
---|
| 27 | !> @note |
---|
| 28 | !> default values are specified between brackets |
---|
| 29 | !> |
---|
| 30 | !> @subsection sublog namlog |
---|
| 31 | !> the logger sub-namelist parameters are : |
---|
| 32 | !> |
---|
| 33 | !> - **cn_logfile** [@a addline.log]<br/> |
---|
| 34 | !> logger filename |
---|
| 35 | !> |
---|
| 36 | !> - **cn_verbosity** [@a warning]<br/> |
---|
| 37 | !> verbosity level, choose between : |
---|
| 38 | !> - trace |
---|
| 39 | !> - debug |
---|
| 40 | !> - info |
---|
| 41 | !> - warning |
---|
| 42 | !> - error |
---|
| 43 | !> - fatal |
---|
| 44 | !> - none |
---|
| 45 | !> |
---|
| 46 | !> - **in_maxerror** [@a 5]<br/> |
---|
| 47 | !> maximum number of error allowed |
---|
| 48 | !> |
---|
| 49 | !> @subsection subcfg namcfg |
---|
| 50 | !> the configuration sub-namelist parameters are : |
---|
| 51 | !> |
---|
| 52 | !> - **cn_varcfg** [@a ./cfg/variable.cfg]<br/> |
---|
| 53 | !> path to the variable configuration file.<br/> |
---|
| 54 | !> the variable configuration file defines standard name, |
---|
| 55 | !> default interpolation method, axis,... |
---|
| 56 | !> to be used for some known variables.<br/> |
---|
| 57 | !> |
---|
| 58 | !> - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/> |
---|
| 59 | !> path to the dimension configuration file.<br/> |
---|
| 60 | !> the dimension configuration file defines dimensions allowed.<br/> |
---|
| 61 | !> |
---|
| 62 | !> - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/> |
---|
| 63 | !> path to the useless (dummy) configuration file.<br/> |
---|
| 64 | !> the dummy configuration file defines useless |
---|
| 65 | !> dimension or variable. these dimension(s) or variable(s) will not be |
---|
| 66 | !> processed.<br/> |
---|
| 67 | !> |
---|
| 68 | !> @subsection subsrc namsrc |
---|
| 69 | !> the source/coarse grid sub-namelist parameters are : |
---|
| 70 | !> |
---|
| 71 | !> - **cn_coord0** [@a ]<br/> |
---|
| 72 | !> path to the coordinate file |
---|
| 73 | !> |
---|
| 74 | !> - **in_perio0** [@a ]<br/> |
---|
| 75 | !> NEMO periodicity index<br/> |
---|
| 76 | !> the NEMO periodicity could be choose between 0 to 6: |
---|
| 77 | !> <dl> |
---|
| 78 | !> <dt>in_perio=0</dt> |
---|
| 79 | !> <dd>standard regional model</dd> |
---|
| 80 | !> <dt>in_perio=1</dt> |
---|
| 81 | !> <dd>east-west cyclic model</dd> |
---|
| 82 | !> <dt>in_perio=2</dt> |
---|
| 83 | !> <dd>model with symmetric boundary condition across the equator</dd> |
---|
| 84 | !> <dt>in_perio=3</dt> |
---|
| 85 | !> <dd>regional model with North fold boundary and T-point pivot</dd> |
---|
| 86 | !> <dt>in_perio=4</dt> |
---|
| 87 | !> <dd>global model with a T-point pivot.<br/> |
---|
| 88 | !> example: ORCA2, ORCA025, ORCA12</dd> |
---|
| 89 | !> <dt>in_perio=5</dt> |
---|
| 90 | !> <dd>regional model with North fold boundary and F-point pivot</dd> |
---|
| 91 | !> <dt>in_perio=6</dt> |
---|
| 92 | !> <dd>global model with a F-point pivot<br/> |
---|
| 93 | !> example: ORCA05</dd> |
---|
| 94 | !> </dd> |
---|
| 95 | !> </dl> |
---|
| 96 | !> @sa For more information see @ref md_src_docsrc_6_perio |
---|
| 97 | !> and Model Boundary Condition paragraph in the |
---|
| 98 | !> [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf) |
---|
| 99 | !> |
---|
| 100 | !> @subsection subvar namvar |
---|
| 101 | !> the variable sub-namelist parameters are : |
---|
| 102 | !> |
---|
| 103 | !> - **cn_varfile** [@a ]<br/> |
---|
| 104 | !> list of variable, and associated file |
---|
| 105 | !> |
---|
| 106 | !> *cn_varfile* is the path and filename of the file where find |
---|
| 107 | !> variable. |
---|
| 108 | !> @note |
---|
| 109 | !> *cn_varfile* could be a matrix of value, if you want to handwrite |
---|
| 110 | !> variable value.<br/> |
---|
| 111 | !> the variable array of value is split into equal subdomain.<br/> |
---|
| 112 | !> each subdomain is filled with the corresponding value |
---|
| 113 | !> of the matrix.<br/> |
---|
| 114 | !> separators used to defined matrix are: |
---|
| 115 | !> - ',' for line |
---|
| 116 | !> - '/' for row |
---|
| 117 | !> Example:<br/> |
---|
| 118 | !> 3,2,3/1,4,5 => @f$ \left( \begin{array}{ccc} |
---|
| 119 | !> 3 & 2 & 3 \\ |
---|
| 120 | !> 1 & 4 & 5 \end{array} \right) @f$ |
---|
| 121 | !> |
---|
| 122 | !> Examples: |
---|
| 123 | !> - 'Bathymetry:gridT.nc' |
---|
| 124 | !> |
---|
| 125 | !> @note |
---|
| 126 | !> Optionnaly, NEMO periodicity could be added following the filename. |
---|
| 127 | !> the periodicity must be separated by ';' |
---|
| 128 | !> |
---|
| 129 | !> Example: |
---|
| 130 | !> - 'Bathymetry:gridT.nc ; perio=4'<br/> |
---|
| 131 | !> |
---|
| 132 | !> - **cn_varinfo** [@a ]<br/> |
---|
| 133 | !> list of variable and extra information about request(s) to be used<br/> |
---|
| 134 | !> |
---|
| 135 | !> each elements of *cn_varinfo* is a string character (separated by ',').<br/> |
---|
| 136 | !> it is composed of the variable name follow by ':', |
---|
| 137 | !> then request(s) to be used on this variable.<br/> |
---|
| 138 | !> request could be: |
---|
| 139 | !> - int = interpolation method |
---|
| 140 | !> - ext = extrapolation method |
---|
| 141 | !> - flt = filter method |
---|
| 142 | !> - min = minimum value |
---|
| 143 | !> - max = maximum value |
---|
| 144 | !> - unt = new units |
---|
| 145 | !> - unf = unit scale factor (linked to new units) |
---|
| 146 | !> |
---|
| 147 | !> requests must be separated by ';'.<br/> |
---|
| 148 | !> order of requests does not matter.<br/> |
---|
| 149 | !> |
---|
| 150 | !> informations about available method could be find in @ref interp, |
---|
| 151 | !> @ref extrap and @ref filter modules.<br/> |
---|
| 152 | !> Example: |
---|
| 153 | !> - 'Bathymetry: flt=2*hamming(2,3); min=0' |
---|
| 154 | !> |
---|
| 155 | !> @note |
---|
| 156 | !> If you do not specify a method which is required, |
---|
| 157 | !> default one is apply. |
---|
| 158 | !> |
---|
| 159 | !> @subsection subout namout |
---|
| 160 | !> the output sub-namelist parameter is : |
---|
| 161 | !> |
---|
| 162 | !> - **cn_fileout** [@a addline_deg.nc]<br/> |
---|
| 163 | !> output filename |
---|
| 164 | !> - @b ln_extrap [@a .FALSE.]<br/> |
---|
| 165 | !> extrapolate extra line |
---|
| 166 | !> - @b ln_copy [@a .FALSE.]<br/> |
---|
| 167 | !> copy extra line from above |
---|
| 168 | !> - **in_nproc** [@a 1]<br/> |
---|
| 169 | !> number of processor to be used |
---|
| 170 | !> - **in_niproc** [@a 1]<br/> |
---|
| 171 | !> i-direction number of processor |
---|
| 172 | !> - **in_njproc** [@a 1]<br/> |
---|
| 173 | !> j-direction numebr of processor |
---|
| 174 | !> |
---|
| 175 | !> <hr> |
---|
| 176 | !> @author J.Paul |
---|
| 177 | !> @date October, 2015 - Initial Version |
---|
| 178 | !> |
---|
| 179 | !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
---|
| 180 | !---------------------------------------------------------------------- |
---|
| 181 | PROGRAM addline_deg |
---|
| 182 | |
---|
| 183 | USE global ! global variable |
---|
| 184 | USE kind ! F90 kind parameter |
---|
| 185 | USE logger ! log file manager |
---|
| 186 | USE fct ! basic useful function |
---|
| 187 | USE date ! date manager |
---|
| 188 | USE att ! attribute manager |
---|
| 189 | USE dim ! dimension manager |
---|
| 190 | USE var ! variable manager |
---|
| 191 | USE file ! file manager |
---|
| 192 | USE multi ! multi file manager |
---|
| 193 | USE iom ! I/O manager |
---|
| 194 | USE grid ! grid manager |
---|
| 195 | USE extrap ! extrapolation manager |
---|
| 196 | USE interp ! interpolation manager |
---|
| 197 | USE filter ! filter manager |
---|
| 198 | USE mpp ! MPP manager |
---|
| 199 | USE iom_mpp ! MPP I/O manager |
---|
| 200 | |
---|
| 201 | IMPLICIT NONE |
---|
| 202 | |
---|
| 203 | ! local variable |
---|
| 204 | CHARACTER(LEN=lc) :: cl_namelist |
---|
| 205 | CHARACTER(LEN=lc) :: cl_date |
---|
| 206 | |
---|
| 207 | INTEGER(i4) :: il_narg |
---|
| 208 | INTEGER(i4) :: il_status |
---|
| 209 | INTEGER(i4) :: il_fileid |
---|
| 210 | INTEGER(i4) :: il_varid |
---|
| 211 | INTEGER(i4) :: il_attid |
---|
| 212 | INTEGER(i4) :: il_index |
---|
| 213 | INTEGER(i4) :: il_nvar |
---|
| 214 | |
---|
| 215 | LOGICAL :: ll_exist |
---|
| 216 | |
---|
| 217 | TYPE(TMPP) :: tl_coord0 |
---|
| 218 | TYPE(TMPP) :: tl_mpp |
---|
| 219 | TYPE(TMPP) :: tl_mppout |
---|
| 220 | |
---|
| 221 | TYPE(TATT) :: tl_att |
---|
| 222 | |
---|
| 223 | TYPE(TVAR) :: tl_lon |
---|
| 224 | TYPE(TVAR) :: tl_lat |
---|
| 225 | TYPE(TVAR) :: tl_depth |
---|
| 226 | TYPE(TVAR) :: tl_time |
---|
| 227 | |
---|
| 228 | TYPE(TVAR) :: tl_tmp |
---|
| 229 | TYPE(TVAR) , DIMENSION(:), ALLOCATABLE :: tl_var |
---|
| 230 | |
---|
| 231 | TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim |
---|
| 232 | |
---|
| 233 | TYPE(TMULTI) :: tl_multi |
---|
| 234 | |
---|
| 235 | ! loop indices |
---|
| 236 | INTEGER(i4) :: ji |
---|
| 237 | INTEGER(i4) :: jj |
---|
| 238 | INTEGER(i4) :: jk |
---|
| 239 | INTEGER(i4) :: jvar |
---|
| 240 | |
---|
| 241 | ! namelist variable |
---|
| 242 | ! namlog |
---|
| 243 | CHARACTER(LEN=lc) :: cn_logfile = 'addline.log' |
---|
| 244 | CHARACTER(LEN=lc) :: cn_verbosity = 'warning' |
---|
| 245 | INTEGER(i4) :: in_maxerror = 5 |
---|
| 246 | |
---|
| 247 | ! namcfg |
---|
| 248 | CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' |
---|
| 249 | CHARACTER(LEN=lc) :: cn_dimcfg = 'dimension.cfg' |
---|
| 250 | CHARACTER(LEN=lc) :: cn_dumcfg = 'dummy.cfg' |
---|
| 251 | |
---|
| 252 | ! namsrc |
---|
| 253 | CHARACTER(LEN=lc) :: cn_coord0 = '' |
---|
| 254 | INTEGER(i4) :: in_perio0 = -1 |
---|
| 255 | |
---|
| 256 | ! namvar |
---|
| 257 | CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' |
---|
| 258 | CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' |
---|
| 259 | |
---|
| 260 | ! namout |
---|
| 261 | CHARACTER(LEN=lc) :: cn_fileout = 'addline_deg.nc' |
---|
| 262 | LOGICAL :: ln_extrap = .FALSE. |
---|
| 263 | LOGICAL :: ln_copy = .FALSE. |
---|
| 264 | INTEGER(i4) :: in_nproc = 0 |
---|
| 265 | INTEGER(i4) :: in_niproc = 0 |
---|
| 266 | INTEGER(i4) :: in_njproc = 0 |
---|
| 267 | CHARACTER(LEN=lc) :: cn_type = 'cdf' |
---|
| 268 | !------------------------------------------------------------------- |
---|
| 269 | |
---|
| 270 | NAMELIST /namlog/ & !< logger namelist |
---|
| 271 | & cn_logfile, & !< log file |
---|
| 272 | & cn_verbosity, & !< log verbosity |
---|
| 273 | & in_maxerror !< logger maximum error |
---|
| 274 | |
---|
| 275 | NAMELIST /namcfg/ & !< configuration namelist |
---|
| 276 | & cn_varcfg, & !< variable configuration file |
---|
| 277 | & cn_dimcfg, & !< dimension configuration file |
---|
| 278 | & cn_dumcfg !< dummy configuration file |
---|
| 279 | |
---|
| 280 | NAMELIST /namsrc/ & !< source/coarse grid namelist |
---|
| 281 | & cn_coord0, & !< coordinate file |
---|
| 282 | & in_perio0 !< periodicity index |
---|
| 283 | |
---|
| 284 | NAMELIST /namvar/ & !< variable namelist |
---|
| 285 | & cn_varinfo, & !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' ) |
---|
| 286 | & cn_varfile !< list of variable file |
---|
| 287 | |
---|
| 288 | NAMELIST /namout/ & !< output namlist |
---|
| 289 | & cn_fileout, & !< fine grid bathymetry file |
---|
| 290 | & ln_extrap, & |
---|
| 291 | & ln_copy, & |
---|
| 292 | & in_niproc, & !< i-direction number of processor |
---|
| 293 | & in_njproc, & !< j-direction numebr of processor |
---|
| 294 | & in_nproc, & !< number of processor to be used |
---|
| 295 | & cn_type !< output type format (dimg, cdf) |
---|
| 296 | !------------------------------------------------------------------- |
---|
| 297 | |
---|
| 298 | ! namelist |
---|
| 299 | ! get namelist |
---|
| 300 | il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec |
---|
| 301 | IF( il_narg/=1 )THEN |
---|
| 302 | PRINT *,"ERROR in addline: need a namelist" |
---|
| 303 | STOP |
---|
| 304 | ELSE |
---|
| 305 | CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec |
---|
| 306 | ENDIF |
---|
| 307 | |
---|
| 308 | ! read namelist |
---|
| 309 | INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) |
---|
| 310 | IF( ll_exist )THEN |
---|
| 311 | |
---|
| 312 | il_fileid=fct_getunit() |
---|
| 313 | |
---|
| 314 | OPEN( il_fileid, FILE=TRIM(cl_namelist), & |
---|
| 315 | & FORM='FORMATTED', & |
---|
| 316 | & ACCESS='SEQUENTIAL', & |
---|
| 317 | & STATUS='OLD', & |
---|
| 318 | & ACTION='READ', & |
---|
| 319 | & IOSTAT=il_status) |
---|
| 320 | CALL fct_err(il_status) |
---|
| 321 | IF( il_status /= 0 )THEN |
---|
| 322 | PRINT *,"ERROR in addline: error opening "//TRIM(cl_namelist) |
---|
| 323 | STOP |
---|
| 324 | ENDIF |
---|
| 325 | |
---|
| 326 | READ( il_fileid, NML = namlog ) |
---|
| 327 | ! define log file |
---|
| 328 | CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror) |
---|
| 329 | CALL logger_header() |
---|
| 330 | |
---|
| 331 | READ( il_fileid, NML = namcfg ) |
---|
| 332 | ! get variable extra information |
---|
| 333 | CALL var_def_extra(TRIM(cn_varcfg)) |
---|
| 334 | |
---|
| 335 | ! get dimension allowed |
---|
| 336 | CALL dim_def_extra(TRIM(cn_dimcfg)) |
---|
| 337 | |
---|
| 338 | ! get dummy variable |
---|
| 339 | CALL var_get_dummy(TRIM(cn_dumcfg)) |
---|
| 340 | ! get dummy dimension |
---|
| 341 | CALL dim_get_dummy(TRIM(cn_dumcfg)) |
---|
| 342 | ! get dummy attribute |
---|
| 343 | CALL att_get_dummy(TRIM(cn_dumcfg)) |
---|
| 344 | |
---|
| 345 | READ( il_fileid, NML = namsrc ) |
---|
| 346 | READ( il_fileid, NML = namvar ) |
---|
| 347 | ! add user change in extra information |
---|
| 348 | CALL var_chg_extra( cn_varinfo ) |
---|
| 349 | ! match variable with file |
---|
| 350 | tl_multi=multi_init(cn_varfile) |
---|
| 351 | |
---|
| 352 | READ( il_fileid, NML = namout ) |
---|
| 353 | |
---|
| 354 | CLOSE( il_fileid, IOSTAT=il_status ) |
---|
| 355 | CALL fct_err(il_status) |
---|
| 356 | IF( il_status /= 0 )THEN |
---|
| 357 | CALL logger_error("ADD LINE: closing "//TRIM(cl_namelist)) |
---|
| 358 | ENDIF |
---|
| 359 | |
---|
| 360 | ELSE |
---|
| 361 | |
---|
| 362 | PRINT *,"ERROR in addline: can't find "//TRIM(cl_namelist) |
---|
| 363 | STOP |
---|
| 364 | |
---|
| 365 | ENDIF |
---|
| 366 | |
---|
| 367 | CALL multi_print(tl_multi) |
---|
| 368 | |
---|
| 369 | ! open files |
---|
| 370 | IF( cn_coord0 /= '' )THEN |
---|
| 371 | tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0) |
---|
| 372 | CALL grid_get_info(tl_coord0) |
---|
| 373 | ELSE |
---|
| 374 | CALL logger_fatal("ADD LINE: no coarse grid coordinate found. "//& |
---|
| 375 | & "check namelist") |
---|
| 376 | ENDIF |
---|
| 377 | |
---|
| 378 | ! check |
---|
| 379 | ! check output file do not already exist |
---|
| 380 | print *,'cn_fileout ',TRIM(cn_fileout) |
---|
| 381 | INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist) |
---|
| 382 | IF( ll_exist )THEN |
---|
| 383 | CALL logger_fatal("ADD LINE: output file "//TRIM(cn_fileout)//& |
---|
| 384 | & " already exist.") |
---|
| 385 | ENDIF |
---|
| 386 | |
---|
| 387 | IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN |
---|
| 388 | CALL logger_error("ADD LINE: no mpp file to work on. "//& |
---|
| 389 | & "check cn_varfile in namelist.") |
---|
| 390 | ELSE |
---|
| 391 | |
---|
| 392 | ALLOCATE( tl_var( tl_multi%i_nvar ) ) |
---|
| 393 | jk=0 |
---|
| 394 | DO ji=1,tl_multi%i_nmpp |
---|
| 395 | |
---|
| 396 | IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN |
---|
| 397 | |
---|
| 398 | CALL logger_fatal("ADD LINE: no variable to work on for "//& |
---|
| 399 | & "mpp file"//TRIM(tl_multi%t_mpp(ji)%c_name)//& |
---|
| 400 | & ". check cn_varfile in namelist.") |
---|
| 401 | ELSE |
---|
| 402 | |
---|
| 403 | WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name) |
---|
| 404 | tl_mpp=mpp_init( file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name)) ) |
---|
| 405 | CALL grid_get_info(tl_mpp) |
---|
| 406 | |
---|
| 407 | ! open mpp file |
---|
| 408 | CALL iom_mpp_open(tl_mpp) |
---|
| 409 | |
---|
| 410 | ! get or check depth value |
---|
| 411 | IF( tl_multi%t_mpp(ji)%t_proc(1)%i_depthid /= 0 )THEN |
---|
| 412 | il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_depthid |
---|
| 413 | IF( ASSOCIATED(tl_depth%d_value) )THEN |
---|
| 414 | tl_tmp=iom_mpp_read_var(tl_mpp,il_varid) |
---|
| 415 | IF( ANY( tl_depth%d_value(:,:,:,:) /= & |
---|
| 416 | & tl_tmp%d_value(:,:,:,:) ) )THEN |
---|
| 417 | CALL logger_fatal("ADD LINE: depth value from "//& |
---|
| 418 | & TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& |
---|
| 419 | & " to those from former file(s).") |
---|
| 420 | ENDIF |
---|
| 421 | CALL var_clean(tl_tmp) |
---|
| 422 | ELSE |
---|
| 423 | tl_depth=iom_mpp_read_var(tl_mpp,il_varid) |
---|
| 424 | ENDIF |
---|
| 425 | ENDIF |
---|
| 426 | |
---|
| 427 | ! get or check time value |
---|
| 428 | IF( tl_multi%t_mpp(ji)%t_proc(1)%i_timeid /= 0 )THEN |
---|
| 429 | il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_timeid |
---|
| 430 | IF( ASSOCIATED(tl_time%d_value) )THEN |
---|
| 431 | tl_tmp=iom_mpp_read_var(tl_mpp,il_varid) |
---|
| 432 | IF( ANY( tl_time%d_value(:,:,:,:) /= & |
---|
| 433 | & tl_tmp%d_value(:,:,:,:) ) )THEN |
---|
| 434 | CALL logger_fatal("ADD LINE: time value from "//& |
---|
| 435 | & TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& |
---|
| 436 | & " to those from former file(s).") |
---|
| 437 | ENDIF |
---|
| 438 | CALL var_clean(tl_tmp) |
---|
| 439 | ELSE |
---|
| 440 | tl_time=iom_mpp_read_var(tl_mpp,il_varid) |
---|
| 441 | ENDIF |
---|
| 442 | ENDIF |
---|
| 443 | |
---|
| 444 | ! close mpp file |
---|
| 445 | CALL iom_mpp_close(tl_mpp) |
---|
| 446 | |
---|
| 447 | !- add line to input file variable |
---|
| 448 | DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar |
---|
| 449 | jk=jk+1 |
---|
| 450 | tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) |
---|
| 451 | WRITE(*,'(2x,a)') "work on variable "//TRIM(tl_tmp%c_name) |
---|
| 452 | |
---|
| 453 | tl_var(jk)=add_line( tl_tmp, tl_mpp, & |
---|
| 454 | & tl_coord0 ) |
---|
| 455 | |
---|
| 456 | IF( ln_copy )THEN |
---|
| 457 | tl_var(jk)%d_value(:,2,:,:)=tl_var(jk)%d_value(:,3,:,:) |
---|
| 458 | ELSEIF( ln_extrap )THEN |
---|
| 459 | ! extrapolate variable |
---|
| 460 | CALL extrap_fill_value( tl_var(jk) ) |
---|
| 461 | ENDIF |
---|
| 462 | ! clean |
---|
| 463 | CALL var_clean(tl_tmp) |
---|
| 464 | |
---|
| 465 | ENDDO |
---|
| 466 | |
---|
| 467 | ENDIF |
---|
| 468 | |
---|
| 469 | ENDDO |
---|
| 470 | |
---|
| 471 | ENDIF |
---|
| 472 | |
---|
| 473 | il_nvar=tl_multi%i_nvar |
---|
| 474 | ! clean |
---|
| 475 | CALL multi_clean(tl_multi) |
---|
| 476 | |
---|
| 477 | ! create file |
---|
| 478 | IF( in_niproc == 0 .AND. & |
---|
| 479 | & in_njproc == 0 .AND. & |
---|
| 480 | & in_nproc == 0 )THEN |
---|
| 481 | in_niproc = 1 |
---|
| 482 | in_njproc = 1 |
---|
| 483 | in_nproc = 1 |
---|
| 484 | ENDIF |
---|
| 485 | |
---|
| 486 | ! add dimension |
---|
| 487 | tl_dim(:)=var_max_dim(tl_var(:)) |
---|
| 488 | |
---|
| 489 | DO ji=1,il_nvar |
---|
| 490 | |
---|
| 491 | IF( ALL(tl_var(ji)%t_dim(:)%i_len == tl_dim(:)%i_len) )THEN |
---|
| 492 | tl_mppout=mpp_init( TRIM(cn_fileout), tl_var(ji), & |
---|
| 493 | & in_niproc, in_njproc, in_nproc, & |
---|
| 494 | & cd_type=cn_type) |
---|
| 495 | EXIT |
---|
| 496 | ENDIF |
---|
| 497 | |
---|
| 498 | ENDDO |
---|
| 499 | |
---|
| 500 | DO ji=1,ip_maxdim |
---|
| 501 | |
---|
| 502 | IF( tl_dim(ji)%l_use )THEN |
---|
| 503 | CALL mpp_move_dim(tl_mppout, tl_dim(ji)) |
---|
| 504 | SELECT CASE(TRIM(tl_dim(ji)%c_sname)) |
---|
| 505 | CASE('z','t') |
---|
| 506 | DO jj=1,tl_mppout%i_nproc |
---|
| 507 | CALL file_add_dim(tl_mppout%t_proc(jj), tl_dim(ji)) |
---|
| 508 | ENDDO |
---|
| 509 | END SELECT |
---|
| 510 | ENDIF |
---|
| 511 | |
---|
| 512 | ENDDO |
---|
| 513 | |
---|
| 514 | ! add variables |
---|
| 515 | IF( ALL( tl_dim(1:2)%l_use ) )THEN |
---|
| 516 | |
---|
| 517 | ! open mpp files |
---|
| 518 | CALL iom_mpp_open(tl_coord0) |
---|
| 519 | |
---|
| 520 | ! add longitude |
---|
| 521 | tl_lon=iom_mpp_read_var(tl_coord0,'longitude') |
---|
| 522 | CALL mpp_add_var(tl_mppout, tl_lon) |
---|
| 523 | CALL var_clean(tl_lon) |
---|
| 524 | |
---|
| 525 | ! add latitude |
---|
| 526 | tl_lat=iom_mpp_read_var(tl_coord0,'latitude') |
---|
| 527 | CALL mpp_add_var(tl_mppout, tl_lat) |
---|
| 528 | CALL var_clean(tl_lat) |
---|
| 529 | |
---|
| 530 | ! close mpp files |
---|
| 531 | CALL iom_mpp_close(tl_coord0) |
---|
| 532 | |
---|
| 533 | ENDIF |
---|
| 534 | |
---|
| 535 | IF( tl_dim(3)%l_use )THEN |
---|
| 536 | IF( ASSOCIATED(tl_depth%d_value) )THEN |
---|
| 537 | ! add depth |
---|
| 538 | CALL mpp_add_var(tl_mppout, tl_depth) |
---|
| 539 | ELSE |
---|
| 540 | CALL logger_warn("CREATE RESTART: no value for depth variable.") |
---|
| 541 | ENDIF |
---|
| 542 | ENDIF |
---|
| 543 | IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth) |
---|
| 544 | |
---|
| 545 | IF( tl_dim(4)%l_use )THEN |
---|
| 546 | IF( ASSOCIATED(tl_time%d_value) )THEN |
---|
| 547 | ! add time |
---|
| 548 | CALL mpp_add_var(tl_mppout, tl_time) |
---|
| 549 | ELSE |
---|
| 550 | CALL logger_warn("CREATE RESTART: no value for time variable.") |
---|
| 551 | ENDIF |
---|
| 552 | ENDIF |
---|
| 553 | IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time) |
---|
| 554 | |
---|
| 555 | ! add other variables |
---|
| 556 | DO jvar=il_nvar,1,-1 |
---|
| 557 | ! check if variable already add |
---|
| 558 | il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name) |
---|
| 559 | IF( il_index == 0 )THEN |
---|
| 560 | CALL mpp_add_var(tl_mppout, tl_var(jvar)) |
---|
| 561 | CALL var_clean(tl_var(jvar)) |
---|
| 562 | ENDIF |
---|
| 563 | ENDDO |
---|
| 564 | |
---|
| 565 | ! add some attribute |
---|
| 566 | tl_att=att_init("Created_by","SIREN addline_deg") |
---|
| 567 | CALL mpp_add_att(tl_mppout, tl_att) |
---|
| 568 | |
---|
| 569 | cl_date=date_print(date_now()) |
---|
| 570 | tl_att=att_init("Creation_date",cl_date) |
---|
| 571 | CALL mpp_add_att(tl_mppout, tl_att) |
---|
| 572 | |
---|
| 573 | ! add attribute periodicity |
---|
| 574 | il_attid=0 |
---|
| 575 | IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN |
---|
| 576 | il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'periodicity') |
---|
| 577 | ENDIF |
---|
| 578 | IF( tl_coord0%i_perio >= 0 .AND. il_attid == 0 )THEN |
---|
| 579 | tl_att=att_init('periodicity',tl_coord0%i_perio) |
---|
| 580 | CALL mpp_add_att(tl_mppout,tl_att) |
---|
| 581 | ENDIF |
---|
| 582 | |
---|
| 583 | il_attid=0 |
---|
| 584 | IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN |
---|
| 585 | il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'ew_overlap') |
---|
| 586 | ENDIF |
---|
| 587 | IF( tl_coord0%i_ew >= 0 .AND. il_attid == 0 )THEN |
---|
| 588 | tl_att=att_init('ew_overlap',tl_coord0%i_ew) |
---|
| 589 | CALL mpp_add_att(tl_mppout,tl_att) |
---|
| 590 | ENDIF |
---|
| 591 | |
---|
| 592 | ! print |
---|
| 593 | CALL mpp_print(tl_mppout) |
---|
| 594 | |
---|
| 595 | ! create file |
---|
| 596 | CALL iom_mpp_create(tl_mppout) |
---|
| 597 | |
---|
| 598 | ! write file |
---|
| 599 | CALL iom_mpp_write_file(tl_mppout) |
---|
| 600 | ! close file |
---|
| 601 | CALL iom_mpp_close(tl_mppout) |
---|
| 602 | |
---|
| 603 | ! clean |
---|
| 604 | CALL att_clean(tl_att) |
---|
| 605 | CALL var_clean(tl_var(:)) |
---|
| 606 | DEALLOCATE(tl_var) |
---|
| 607 | |
---|
| 608 | CALL mpp_clean(tl_mppout) |
---|
| 609 | CALL mpp_clean(tl_coord0) |
---|
| 610 | |
---|
| 611 | ! close log file |
---|
| 612 | CALL logger_footer() |
---|
| 613 | CALL logger_close() |
---|
| 614 | |
---|
| 615 | CONTAINS |
---|
| 616 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 617 | FUNCTION add_line(td_var, td_mpp, td_coord) & |
---|
| 618 | & RESULT(tf_var) |
---|
| 619 | !------------------------------------------------------------------- |
---|
| 620 | !> @brief |
---|
| 621 | !> This function add line to variable and return variable structure |
---|
| 622 | !> |
---|
| 623 | !> @author J.Paul |
---|
| 624 | !> @date October, 2015 - Initial Version |
---|
| 625 | !> |
---|
| 626 | !> @param[in] td_var variable structure |
---|
| 627 | !> @param[in] td_mpp mpp file structure |
---|
| 628 | !> @param[in] td_coord coordinate file structure |
---|
| 629 | !> @return variable structure |
---|
| 630 | !------------------------------------------------------------------- |
---|
| 631 | |
---|
| 632 | IMPLICIT NONE |
---|
| 633 | |
---|
| 634 | ! Argument |
---|
| 635 | TYPE(TVAR), INTENT(IN) :: td_var |
---|
| 636 | TYPE(TMPP), INTENT(IN) :: td_mpp |
---|
| 637 | TYPE(TMPP), INTENT(IN) :: td_coord |
---|
| 638 | |
---|
| 639 | ! function |
---|
| 640 | TYPE(TVAR) :: tf_var |
---|
| 641 | |
---|
| 642 | ! local variable |
---|
| 643 | INTEGER(i4), DIMENSION(2,2) :: il_ghost |
---|
| 644 | |
---|
| 645 | TYPE(TMPP) :: tl_mpp |
---|
| 646 | |
---|
| 647 | TYPE(TATT) :: tl_att |
---|
| 648 | |
---|
| 649 | TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim |
---|
| 650 | ! loop indices |
---|
| 651 | !---------------------------------------------------------------- |
---|
| 652 | |
---|
| 653 | IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN |
---|
| 654 | CALL logger_error("ADD LINE: no processor associated "//& |
---|
| 655 | & "to mpp "//TRIM(td_mpp%c_name)) |
---|
| 656 | ELSE |
---|
| 657 | |
---|
| 658 | !init |
---|
| 659 | tl_mpp=mpp_copy(td_mpp) |
---|
| 660 | il_ghost(:,:)=0 |
---|
| 661 | |
---|
| 662 | tl_dim(:)=dim_copy(td_coord%t_dim(:)) |
---|
| 663 | |
---|
| 664 | ! ghost cell to be added |
---|
| 665 | il_ghost(jp_I,:)=(/0,0/) |
---|
| 666 | il_ghost(jp_J,:)=(/1,0/) |
---|
| 667 | |
---|
| 668 | ! open mpp files |
---|
| 669 | CALL iom_mpp_open(tl_mpp) |
---|
| 670 | |
---|
| 671 | ! read variable |
---|
| 672 | tf_var=iom_mpp_read_var(tl_mpp,TRIM(td_var%c_name)) |
---|
| 673 | |
---|
| 674 | ! close mpp file |
---|
| 675 | CALL iom_mpp_close(tl_mpp) |
---|
| 676 | |
---|
| 677 | ! add ghost cell |
---|
| 678 | CALL grid_add_ghost(tf_var,il_ghost(:,:)) |
---|
| 679 | |
---|
| 680 | ! add attribute to variable |
---|
| 681 | tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) |
---|
| 682 | CALL var_move_att(tf_var, tl_att) |
---|
| 683 | |
---|
| 684 | tl_att=att_init('add_i_line',(/il_ghost(jp_I,1), il_ghost(jp_I,2)/)) |
---|
| 685 | CALL var_move_att(tf_var, tl_att) |
---|
| 686 | |
---|
| 687 | tl_att=att_init('add_j_line',(/il_ghost(jp_J,1), il_ghost(jp_J,2)/)) |
---|
| 688 | CALL var_move_att(tf_var, tl_att) |
---|
| 689 | |
---|
| 690 | ! clean structure |
---|
| 691 | CALL att_clean(tl_att) |
---|
| 692 | CALL mpp_clean(tl_mpp) |
---|
| 693 | ENDIF |
---|
| 694 | |
---|
| 695 | END FUNCTION add_line |
---|
| 696 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 697 | END PROGRAM |
---|