Changeset 5600 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/create_restart.f90
- Timestamp:
- 2015-07-15T17:46:12+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/create_restart.f90
r4213 r5600 7 7 ! 8 8 ! DESCRIPTION: 9 !> @file 9 10 !> @brief 10 11 !> This program create restart file. 11 12 !> 12 13 !> @details 13 !> Variables are read from restart file, or standard output. 14 !> Then theses variables are interpolated on fine grid. 15 !> Finally table are split over new decomposition. 16 !> 17 !> @author 18 !> J.Paul 14 !> @section sec1 method 15 !> Variables could be extracted from fine grid file, interpolated from coarse 16 !> grid file or restart file, or manually written.<br/> 17 !> Then they are split over new decomposition. 18 !> @note 19 !> method could be different for each variable. 20 !> 21 !> @section sec2 how to 22 !> to create restart file:<br/> 23 !> @code{.sh} 24 !> ./SIREN/bin/create_restart create_restart.nam 25 !> @endcode 26 !> 27 !> create_restart.nam comprise 9 namelists:<br/> 28 !> - logger namelist (namlog) 29 !> - config namelist (namcfg) 30 !> - coarse grid namelist (namcrs) 31 !> - fine grid namelist (namfin) 32 !> - vertical grid namelist (namzgr) 33 !> - partial step namelist (namzps) 34 !> - variable namelist (namvar) 35 !> - nesting namelist (namnst) 36 !> - output namelist (namout) 37 !> 38 !> @note 39 !> All namelists have to be in file create_restart.nam 40 !> however variables of those namelists are all optional. 41 !> 42 !> * _logger namelist (namlog)_:<br/> 43 !> - cn_logfile : log filename 44 !> - cn_verbosity : verbosity ('trace','debug','info', 45 !> 'warning','error','fatal') 46 !> - in_maxerror : maximum number of error allowed 47 !> 48 !> * _config namelist (namcfg)_:<br/> 49 !> - cn_varcfg : variable configuration file 50 !> (see ./SIREN/cfg/variable.cfg) 51 !> 52 !> * _coarse grid namelist (namcrs):<br/> 53 !> - cn_coord0 : coordinate file 54 !> - in_perio0 : NEMO periodicity index (see Model Boundary Condition in 55 !> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals)) 56 !> 57 !> * _fine grid namelist (namfin)_:<br/> 58 !> - cn_coord1 : coordinate file 59 !> - cn_bathy1 : bathymetry file 60 !> - in_perio1 : NEMO periodicity index 61 !> - in_extrap : number of land point to be extrapolated 62 !> before writing file 63 !> 64 !> * _vertical grid namelist (namzgr)_:<br/> 65 !> - dn_pp_to_be_computed : 66 !> - dn_ppsur : 67 !> - dn_ppa0 : 68 !> - dn_ppa1 : 69 !> - dn_ppa2 : 70 !> - dn_ppkth : 71 !> - dn_ppkth2 : 72 !> - dn_ppacr : 73 !> - dn_ppacr2 : 74 !> - dn_ppdzmin : 75 !> - dn_pphmax : 76 !> - in_nlevel : number of vertical level 77 !> 78 !> * _partial step namelist (namzps)_:<br/> 79 !> - dn_e3zps_min : 80 !> - dn_e3zps_rat : 81 !> 82 !> * _variable namelist (namvar)_:<br/> 83 !> - cn_varinfo : list of variable and extra information about request(s) 84 !> to be used.<br/> 85 !> each elements of *cn_varinfo* is a string character.<br/> 86 !> it is composed of the variable name follow by ':', 87 !> then request(s) to be used on this variable.<br/> 88 !> request could be: 89 !> - interpolation method 90 !> - extrapolation method 91 !> - filter method 92 !> - > minimum value 93 !> - < maximum value 94 !> 95 !> requests must be separated by ';'.<br/> 96 !> order of requests does not matter.<br/> 97 !> 98 !> informations about available method could be find in @ref interp, 99 !> @ref extrap and @ref filter.<br/> 100 !> Example: 'votemper: linear; hann; dist_weight','vosaline: cubic' 101 !> @note 102 !> If you do not specify a method which is required, 103 !> default one is apply. 104 !> - cn_varfile : list of variable, and corresponding file<br/> 105 !> *cn_varfile* is the path and filename of the file where find 106 !> variable.<br/> 107 !> @note 108 !> *cn_varfile* could be a matrix of value, if you want to filled 109 !> manually variable value.<br/> 110 !> the variable array of value is split into equal subdomain.<br/> 111 !> Each subdomain is filled with the corresponding value 112 !> of the matrix.<br/> 113 !> separators used to defined matrix are: 114 !> - ',' for line 115 !> - '/' for row 116 !> - '\' for level<br/> 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 !> - 'votemper:gridT.nc', 'vozocrtx:gridU.nc' 124 !> - 'votemper:10\25', 'vozocrtx:gridU.nc' 125 !> 126 !> to get all variable from one file: 127 !> - 'all:restart.dimg' 128 !> 129 !> * _nesting namelist (namnst)_:<br/> 130 !> - in_rhoi : refinement factor in i-direction 131 !> - in_rhoj : refinement factor in j-direction 132 !> @note 133 !> coarse grid indices will be deduced from fine grid 134 !> coordinate file. 135 !> 136 !> * _output namelist (namout)_:<br/> 137 !> - cn_fileout : output file 138 !> - in_nproc : total number of processor to be used 139 !> - in_niproc : i-direction number of processor 140 !> - in_njproc : j-direction numebr of processor 141 !> - cn_type : output format ('dimg', 'cdf') 142 !> 143 !> @author J.Paul 19 144 ! REVISION HISTORY: 20 !> @date Nov, 2013 - Initial Version 21 ! 145 !> @date November, 2013 - Initial Version 146 !> @date September, 2014 147 !> - add header for user 148 !> - offset computed considering grid point 149 !> - add attributes in output variable 150 !> 22 151 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 23 !>24 !> @todo25 !> - add attributes indices and refinement in output file26 !> - check fileout exist at the beginning27 152 !---------------------------------------------------------------------- 28 !> @code29 153 PROGRAM create_restart 30 154 31 ! USE netcdf ! nf90 library32 155 USE global ! global variable 33 156 USE kind ! F90 kind parameter … … 41 164 USE multi ! multi file manager 42 165 USE iom ! I/O manager 43 USE dom ! domain manager44 166 USE grid ! grid manager 45 167 USE vgrid ! vertical grid manager … … 48 170 USE filter ! filter manager 49 171 USE mpp ! MPP manager 172 USE dom ! domain manager 50 173 USE iom_mpp ! MPP I/O manager 174 USE iom_dom ! DOM I/O manager 51 175 52 176 IMPLICIT NONE … … 58 182 CHARACTER(LEN=lc) :: cl_name 59 183 CHARACTER(LEN=lc) :: cl_data 184 CHARACTER(LEN=lc) :: cl_fileout 60 185 61 186 INTEGER(i4) :: il_narg 62 187 INTEGER(i4) :: il_status 63 188 INTEGER(i4) :: il_fileid 189 INTEGER(i4) :: il_nvar 64 190 INTEGER(i4) :: il_attid 191 INTEGER(i4) :: il_imin1 192 INTEGER(i4) :: il_imax1 193 INTEGER(i4) :: il_jmin1 194 INTEGER(i4) :: il_jmax1 65 195 INTEGER(i4) :: il_imin0 66 196 INTEGER(i4) :: il_imax0 67 197 INTEGER(i4) :: il_jmin0 68 198 INTEGER(i4) :: il_jmax0 199 INTEGER(i4) :: il_index 69 200 INTEGER(i4) , DIMENSION(ip_maxdim) :: il_rho 70 INTEGER(i4) , DIMENSION(2 ):: il_xghost201 INTEGER(i4) , DIMENSION(2,2) :: il_xghost 71 202 INTEGER(i4) , DIMENSION(2,2) :: il_offset 72 INTEGER(i4) , DIMENSION(2,2 ,2):: il_ind203 INTEGER(i4) , DIMENSION(2,2) :: il_ind 73 204 74 205 LOGICAL :: ll_exist 75 76 TYPE(TFILE) :: tl_coord077 TYPE(TFILE) :: tl_coord178 TYPE(TFILE) :: tl_bathy179 TYPE(TFILE) :: tl_file80 206 81 207 TYPE(TDOM) :: tl_dom1 … … 88 214 TYPE(TVAR) :: tl_lon 89 215 TYPE(TVAR) :: tl_lat 90 TYPE(TVAR) :: tl_tmp91 216 TYPE(TVAR) , DIMENSION(:) , ALLOCATABLE :: tl_var 92 217 TYPE(TVAR) , DIMENSION(:) , ALLOCATABLE :: tl_level … … 94 219 TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim 95 220 221 TYPE(TMPP) :: tl_coord0 222 TYPE(TMPP) :: tl_coord1 223 TYPE(TMPP) :: tl_bathy1 96 224 TYPE(TMPP) :: tl_mpp 97 225 TYPE(TMPP) :: tl_mppout 226 98 227 TYPE(TMULTI) :: tl_multi 99 228 … … 104 233 105 234 ! namelist variable 235 ! namlog 106 236 CHARACTER(LEN=lc) :: cn_logfile = 'create_restart.log' 107 237 CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 108 238 INTEGER(i4) :: in_maxerror = 5 239 240 ! namcfg 109 241 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 110 242 243 ! namcrs 111 244 CHARACTER(LEN=lc) :: cn_coord0 = '' 112 245 INTEGER(i4) :: in_perio0 = -1 113 246 247 ! namfin 114 248 CHARACTER(LEN=lc) :: cn_coord1 = '' 115 249 CHARACTER(LEN=lc) :: cn_bathy1 = '' 116 250 INTEGER(i4) :: in_perio1 = -1 117 251 INTEGER(i4) :: in_extrap = 0 118 LOGICAL :: ln_fillclosed = .TRUE. 119 120 CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varinfo = '' 121 CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varfile = '' 122 123 INTEGER(i4) :: in_imin0 = 0 124 INTEGER(i4) :: in_imax0 = 0 125 INTEGER(i4) :: in_jmin0 = 0 126 INTEGER(i4) :: in_jmax0 = 0 252 253 !namzgr 254 REAL(dp) :: dn_pp_to_be_computed = 0._dp 255 REAL(dp) :: dn_ppsur = -3958.951371276829_dp 256 REAL(dp) :: dn_ppa0 = 103.9530096000000_dp 257 REAL(dp) :: dn_ppa1 = 2.4159512690000_dp 258 REAL(dp) :: dn_ppa2 = 100.7609285000000_dp 259 REAL(dp) :: dn_ppkth = 15.3510137000000_dp 260 REAL(dp) :: dn_ppkth2 = 48.0298937200000_dp 261 REAL(dp) :: dn_ppacr = 7.0000000000000_dp 262 REAL(dp) :: dn_ppacr2 = 13.000000000000_dp 263 REAL(dp) :: dn_ppdzmin = 6._dp 264 REAL(dp) :: dn_pphmax = 5750._dp 265 INTEGER(i4) :: in_nlevel = 75 266 267 !namzps 268 REAL(dp) :: dn_e3zps_min = 25._dp 269 REAL(dp) :: dn_e3zps_rat = 0.2_dp 270 271 ! namvar 272 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 273 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 274 275 ! namnst 127 276 INTEGER(i4) :: in_rhoi = 0 128 277 INTEGER(i4) :: in_rhoj = 0 129 278 130 CHARACTER(LEN=lc) :: cn_fileout = 'restart' 279 ! namout 280 CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc' 131 281 INTEGER(i4) :: in_nproc = 0 132 282 INTEGER(i4) :: in_niproc = 0 … … 138 288 NAMELIST /namlog/ & !< logger namelist 139 289 & cn_logfile, & !< log file 140 & cn_verbosity !< log verbosity 290 & cn_verbosity, & !< log verbosity 291 & in_maxerror !< logger maximum error 141 292 142 293 NAMELIST /namcfg/ & !< configuration namelist 143 294 & cn_varcfg !< variable configuration file 144 295 145 NAMELIST /namcrs/ & 146 & cn_coord0, & 147 & in_perio0 296 NAMELIST /namcrs/ & !< coarse grid namelist 297 & cn_coord0, & !< coordinate file 298 & in_perio0 !< periodicity index 148 299 149 NAMELIST /namfin/ & !< fine grid namelist 150 & cn_coord1, & !< coordinate file 151 & cn_bathy1, & !< bathymetry file 152 & in_perio1, & !< periodicity index 153 & in_extrap, & !< 154 & ln_fillclosed !< fill closed sea 300 NAMELIST /namfin/ & !< fine grid namelist 301 & cn_coord1, & !< coordinate file 302 & cn_bathy1, & !< bathymetry file 303 & in_perio1, & !< periodicity index 304 & in_extrap 155 305 306 NAMELIST /namzgr/ & 307 & dn_pp_to_be_computed, & 308 & dn_ppsur, & 309 & dn_ppa0, & 310 & dn_ppa1, & 311 & dn_ppa2, & 312 & dn_ppkth, & 313 & dn_ppkth2, & 314 & dn_ppacr, & 315 & dn_ppacr2, & 316 & dn_ppdzmin, & 317 & dn_pphmax, & 318 & in_nlevel !< number of vertical level 319 320 NAMELIST /namzps/ & 321 & dn_e3zps_min, & 322 & dn_e3zps_rat 323 156 324 NAMELIST /namvar/ & !< variable namelist 157 & cn_varinfo, & !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' )325 & cn_varinfo, & !< list of variable and interpolation method to be used. 158 326 & cn_varfile !< list of variable file 159 327 160 328 NAMELIST /namnst/ & !< nesting namelist 161 & in_imin0, & !< i-direction lower left point indice162 & in_imax0, & !< i-direction upper right point indice163 & in_jmin0, & !< j-direction lower left point indice164 & in_jmax0, & !< j-direction upper right point indice165 329 & in_rhoi, & !< refinement factor in i-direction 166 330 & in_rhoj !< refinement factor in j-direction … … 174 338 !------------------------------------------------------------------- 175 339 176 ! 1-namelist177 ! 1-1get namelist340 ! namelist 341 ! get namelist 178 342 il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec 179 343 IF( il_narg/=1 )THEN … … 184 348 ENDIF 185 349 186 ! 1-2read namelist350 ! read namelist 187 351 INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 188 352 IF( ll_exist )THEN … … 203 367 204 368 READ( il_fileid, NML = namlog ) 205 ! 1-2-1define log file206 CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity) )369 ! define log file 370 CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror) 207 371 CALL logger_header() 208 372 209 373 READ( il_fileid, NML = namcfg ) 210 ! 1-2-2get variable extra information374 ! get variable extra information 211 375 CALL var_def_extra(TRIM(cn_varcfg)) 212 376 213 377 READ( il_fileid, NML = namcrs ) 214 378 READ( il_fileid, NML = namfin ) 379 READ( il_fileid, NML = namzgr ) 215 380 READ( il_fileid, NML = namvar ) 216 ! 1-2-3add user change in extra information381 ! add user change in extra information 217 382 CALL var_chg_extra(cn_varinfo) 218 ! 1-2-4match variable with file383 ! match variable with file 219 384 tl_multi=multi_init(cn_varfile) 220 385 … … 231 396 232 397 PRINT *,"ERROR in create_restart: can't find "//TRIM(cl_namelist) 233 234 ENDIF 235 236 !2- open files 398 STOP 399 400 ENDIF 401 402 ! 403 CALL multi_print(tl_multi) 404 IF( tl_multi%i_nvar <= 0 )THEN 405 CALL logger_fatal("CREATE RESTART: no variable to be used."//& 406 & " check namelist.") 407 ENDIF 408 409 ! open files 237 410 IF( cn_coord0 /= '' )THEN 238 tl_coord0= file_init(TRIM(cn_coord0),id_perio=in_perio0)239 CALL iom_open(tl_coord0)411 tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0) 412 CALL grid_get_info(tl_coord0) 240 413 ELSE 241 414 CALL logger_fatal("CREATE RESTART: no coarse grid coordinate found. "//& … … 244 417 245 418 IF( TRIM(cn_coord1) /= '' )THEN 246 tl_coord1= file_init(TRIM(cn_coord1),id_perio=in_perio1)247 CALL iom_open(tl_coord1)419 tl_coord1=mpp_init( file_init(TRIM(cn_coord1)), id_perio=in_perio1) 420 CALL grid_get_info(tl_coord1) 248 421 ELSE 249 422 CALL logger_fatal("CREATE RESTART: no fine grid coordinate found. "//& … … 252 425 253 426 IF( TRIM(cn_bathy1) /= '' )THEN 254 tl_bathy1= file_init(TRIM(cn_bathy1),id_perio=in_perio1)255 CALL iom_open(tl_bathy1)427 tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1) 428 CALL grid_get_info(tl_bathy1) 256 429 ELSE 257 430 CALL logger_fatal("CREATE RESTART: no fine grid bathymetry found. "//& … … 259 432 ENDIF 260 433 261 !3- check 262 !3-2-1 check refinement factor 434 ! check 435 ! check output file do not already exist 436 cl_fileout=file_rename(cn_fileout,1) 437 INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist) 438 IF( ll_exist )THEN 439 CALL logger_fatal("CREATE RESTART: output file "//TRIM(cl_fileout)//& 440 & " already exist.") 441 ENDIF 442 443 ! check refinement factor 263 444 il_rho(:)=1 264 445 IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN … … 270 451 ENDIF 271 452 272 IF( cn_coord0 /= '' )THEN !.OR. cn_bathy0 /= '' )THEN 273 274 !3-1 check namelist 275 IF( in_imin0 < 1 .OR. in_imax0 < 1 .OR. in_jmin0 < 1 .OR. in_jmax0 < 1)THEN 276 ! compute coarse grid indices around fine grid 277 IF( cn_coord0 /= '' )THEN 278 il_ind(:,:,:)=grid_get_coarse_index(tl_coord0, tl_coord1 ) 279 ENDIF 280 281 il_imin0=il_ind(1,1,1) ; il_imax0=il_ind(1,2,1) 282 il_jmin0=il_ind(2,1,1) ; il_jmax0=il_ind(2,2,1) 283 284 il_offset(:,:)=il_ind(:,:,2) 285 ELSE 286 il_imin0=in_imin0 ; il_imax0=in_imax0 287 il_jmin0=in_jmin0 ; il_jmax0=in_jmax0 288 289 il_offset(1,:)=FLOOR(REAL(il_rho(jp_I)-1,dp)*0.5) 290 il_offset(2,:)=FLOOR(REAL(il_rho(jp_J)-1,dp)*0.5) 291 ENDIF 292 293 !3-2 check domain validity 294 IF( cn_coord0 /= '' )THEN 295 CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0) 296 ENDIF 297 298 !3-3 check coordinate file 299 IF( cn_coord0 /= '' )THEN 300 CALL grid_check_coincidence( tl_coord0, tl_coord1, & 301 & il_imin0, il_imax0, & 302 & il_jmin0, il_jmax0, & 303 & il_rho(:) ) 304 ENDIF 305 306 ENDIF 453 ! check domain indices 454 ! compute coarse grid indices around fine grid 455 il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, & 456 & id_rho=il_rho(:)) 457 458 il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2) 459 il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2) 460 461 ! check domain validity 462 CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0) 463 464 !3-2-4 check coincidence between coarse and fine grid 465 CALL grid_check_coincidence( tl_coord0, tl_coord1, & 466 & il_imin0, il_imax0, & 467 & il_jmin0, il_jmax0, & 468 & il_rho(:) ) 307 469 308 470 ! compute level 309 ALLOCATE(tl_level(i g_npoint))471 ALLOCATE(tl_level(ip_npoint)) 310 472 tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 311 473 312 474 ! remove ghost cell 313 il_xghost(:)=grid_get_ghost(tl_bathy1) 314 315 DO ji=1,ig_npoint 316 CALL grid_del_ghost(tl_level(ji), il_xghost(1), il_xghost(2)) 475 il_xghost(:,:)=grid_get_ghost(tl_bathy1) 476 DO ji=1,ip_npoint 477 CALL grid_del_ghost(tl_level(ji), il_xghost(:,:)) 317 478 ENDDO 318 479 319 ! cl ose320 CALL iom_close(tl_bathy1)321 322 ! 4-work on variables323 IF( .NOT. ASSOCIATED(tl_multi%t_ file) )THEN480 ! clean 481 CALL mpp_clean(tl_bathy1) 482 483 ! work on variables 484 IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN 324 485 CALL logger_error("CREATE RESTART: no file to work on. "//& 325 486 & "check cn_varfile in namelist.") 326 487 ELSE 327 488 ALLOCATE( tl_var( tl_multi%i_nvar ) ) 489 328 490 jvar=0 329 491 ! for each file 330 DO ji=1,tl_multi%i_n file331 WRITE(cl_data,'(a,i2.2)') 'data _',jvar+1332 333 IF( .NOT. ASSOCIATED(tl_multi%t_ file(ji)%t_var) )THEN492 DO ji=1,tl_multi%i_nmpp 493 WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1 494 495 IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN 334 496 335 497 CALL logger_error("CREATE RESTART: no variable to work on for "//& 336 & " file "//TRIM(tl_multi%t_file(ji)%c_name)//&498 & "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//& 337 499 & ". check cn_varfile in namelist.") 338 500 339 ELSEIF( TRIM(tl_multi%t_file(ji)%c_name) == TRIM(cl_data) )THEN 340 !4-1 use input matrix to fill variable 341 501 ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN 502 !- use input matrix to fill variable 503 504 WRITE(*,'(a)') "work on data" 342 505 ! for each variable initialise from matrix 343 DO jj=1,tl_multi%t_file(ji)%i_nvar 506 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 507 344 508 jvar=jvar+1 345 tl_tmp=tl_multi%t_file(ji)%t_var(jj) 346 !4-1-1 fill value with matrix data 347 ! pb voir comment gerer nb de dimension 348 tl_var(jvar)=create_restart_matrix(tl_tmp, tl_coord1) 349 350 !4-1-2 use mask 351 CALL create_restart_mask(tl_var(jvar), tl_level(:)) 509 510 WRITE(*,'(2x,a,a)') "work on variable "//& 511 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 512 513 ! fill value with matrix data 514 tl_var(jvar) = create_restart_matrix( & 515 & tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, & 516 & in_nlevel, tl_level(:) ) 517 352 518 ENDDO 353 519 !- end of use input matrix to fill variable 354 520 ELSE 355 !4-2 use file to fill variable 356 357 ! open file 358 tl_file=file_init(TRIM(tl_multi%t_file(ji)%c_name)) 359 CALL iom_open(tl_file) 521 !- use mpp file to fill variable 522 523 WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name) 524 ! 525 tl_mpp=mpp_init( file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name)) ) 526 CALL grid_get_info(tl_mpp) 527 528 ! check vertical dimension 529 IF( tl_mpp%t_dim(jp_K)%l_use .AND. & 530 & tl_mpp%t_dim(jp_K)%i_len /= in_nlevel )THEN 531 CALL logger_error("CREATE RESTART: dimension in file "//& 532 & TRIM(tl_mpp%c_name)//" not agree with namelist in_nlevel ") 533 ENDIF 534 535 ! open mpp file 536 CALL iom_mpp_open(tl_mpp) 360 537 361 538 ! get or check depth value 362 IF( tl_file%i_depthid /= 0 )THEN 363 IF( ASSOCIATED(tl_depth%d_value) )THEN 364 IF( ANY( tl_depth%d_value(:,:,:,:) /= & 365 & tl_tmp%d_value(:,:,:,:) ) )THEN 366 CALL logger_fatal("CREATE RESTART: depth value from "//& 367 & TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& 368 & " to those from former file(s).") 369 ENDIF 370 ELSE 371 tl_depth=iom_read_var(tl_file,tl_file%i_depthid) 539 CALL create_restart_check_depth( tl_mpp, tl_depth ) 540 541 ! get or check time value 542 CALL create_restart_check_time( tl_mpp, tl_time ) 543 544 ! close mpp file 545 CALL iom_mpp_close(tl_mpp) 546 547 IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 548 & tl_coord0%t_dim(1:2)%i_len) )THEN 549 !!! extract value from fine grid 550 551 IF( ANY( tl_mpp%t_dim(1:2)%i_len <= & 552 & tl_coord1%t_dim(1:2)%i_len) )THEN 553 CALL logger_fatal("CREATE RESTART: dimension in file "//& 554 & TRIM(tl_mpp%c_name)//" smaller than those in fine"//& 555 & " grid coordinates.") 372 556 ENDIF 373 ENDIF 374 375 ! get or check time value 376 IF( tl_file%i_timeid /= 0 )THEN 377 IF( ASSOCIATED(tl_time%d_value) )THEN 378 IF( ANY( tl_time%d_value(:,:,:,:) /= & 379 & tl_tmp%d_value(:,:,:,:) ) )THEN 380 CALL logger_fatal("CREATE RESTART: time value from "//& 381 & TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& 382 & " to those from former file(s).") 383 ENDIF 384 ELSE 385 tl_time=iom_read_var(tl_file,tl_file%i_timeid) 386 ENDIF 387 ENDIF 388 389 IF( ANY( tl_file%t_dim(1:2)%i_len /= & 390 & tl_coord0%t_dim(1:2)%i_len) )THEN 391 !4-2-1 extract value from fine grid 392 393 !4-2-1-1 compute domain on fine grid 394 tl_dom1=create__restart_get_dom_coord(tl_file, tl_coord1) 557 558 ! compute domain on fine grid 559 il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 ) 560 561 il_imin1=il_ind(1,1) ; il_imax1=il_ind(1,2) 562 il_jmin1=il_ind(2,1) ; il_jmax1=il_ind(2,2) 563 564 !- check grid coincidence 565 CALL grid_check_coincidence( tl_mpp, tl_coord1, & 566 & il_imin1, il_imax1, & 567 & il_jmin1, il_jmax1, & 568 & il_rho(:) ) 569 570 ! compute domain 571 tl_dom1=dom_init(tl_mpp, & 572 & il_imin1, il_imax1, & 573 & il_jmin1, il_jmax1) 395 574 396 ! open mpp file on domain 397 !4-2-1-2 init mpp structure 398 tl_mpp=mpp_init(tl_file) 399 400 !4-2-1-3 get processor to be used 401 CALL mpp_get_use( tl_mpp, tl_dom1 ) 402 !4-2-1-4 open mpp files 403 CALL iom_mpp_open(tl_mpp) 575 ! open mpp files 576 CALL iom_dom_open(tl_mpp, tl_dom1) 404 577 405 578 ! for each variable of this file 406 DO jj=1,tl_multi%t_file(ji)%i_nvar 579 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 580 581 WRITE(*,'(2x,a,a)') "work on variable "//& 582 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 583 407 584 jvar=jvar+1 408 cl_name=tl_multi%t_file(ji)%t_var(jj)%c_name 409 !4-2-1-5 read variable over domain 410 tl_var(jvar)=iom_mpp_read_var( tl_mpp, TRIM(cl_name), & 411 & td_dom=tl_dom1 ) 412 413 !4-2-1-7 add attribute to variable 585 cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name 586 ! read variable over domain 587 tl_var(jvar)=iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom1) 588 589 ! add attribute to variable 414 590 tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 415 591 CALL var_move_att(tl_var(jvar), tl_att) 416 592 593 tl_att=att_init('src_i_indices',(/il_imin0, il_imax0/)) 594 CALL var_move_att(tl_var(jvar), tl_att) 595 596 tl_att=att_init('src_j_indices',(/il_jmin0, il_jmax0/)) 597 CALL var_move_att(tl_var(jvar), tl_att) 598 417 599 ! clean structure 418 600 CALL att_clean(tl_att) 419 601 420 ! 4-2-1-8use mask602 ! use mask 421 603 CALL create_restart_mask(tl_var(jvar), tl_level(:)) 422 604 423 !4-2-1-9 add ghost cell 424 CALL grid_add_ghost( tl_var(jvar), & 425 & tl_dom1%i_ighost,tl_dom1%i_jghost ) 605 ! add ghost cell 606 CALL grid_add_ghost( tl_var(jvar), tl_dom1%i_ghost(:,:) ) 426 607 427 608 ENDDO 428 609 429 !4-2-1-2 close mpp file 430 CALL iom_mpp_close(tl_mpp) 610 ! close mpp file 611 CALL iom_dom_close(tl_mpp) 612 431 613 ! clean structure 432 614 CALL mpp_clean(tl_mpp) … … 434 616 435 617 ELSE 436 !4-2-2 get value from coarse grid 437 438 !4-2-2-1 compute domain on coarse grid 439 tl_dom0=create__restart_get_dom_index(tl_file, il_imin0, il_jmin0, & 440 & il_imax0, il_jmax0) 441 442 !4-2-2-2 add extra band (if possible) to compute interpolation 618 !!! get value from coarse grid 619 620 ! compute domain on coarse grid 621 tl_dom0=dom_init(tl_mpp, & 622 & il_imin0, il_imax0, & 623 & il_jmin0, il_jmax0 ) 624 625 ! add extra band (if possible) to compute interpolation 443 626 CALL dom_add_extra(tl_dom0) 444 627 445 ! open mpp file on domain 446 !4-2-2-3 init mpp structure 447 tl_mpp=mpp_init(tl_file) 448 449 !4-2-2-4 get processor to be used 450 CALL mpp_get_use( tl_mpp, tl_dom0 ) 451 452 !4-2-2-5 open mpp files 453 CALL iom_mpp_open(tl_mpp) 454 628 ! open mpp files 629 CALL iom_dom_open(tl_mpp, tl_dom0) 455 630 ! for each variable of this file 456 DO jj=1,tl_multi%t_file(ji)%i_nvar 631 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 632 633 WRITE(*,'(2x,a,a)') "work on variable "//& 634 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 457 635 458 636 jvar=jvar+1 459 cl_name=tl_multi%t_file(ji)%t_var(jj)%c_name 460 print *,'work on ',trim(cl_name) 461 !4-2-2-6 read variable over domain 462 tl_var(jvar)=iom_mpp_read_var( tl_mpp, TRIM(cl_name), & 463 & td_dom=tl_dom0 ) 464 465 !4-2-2-7 interpolate variable 637 cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name 638 639 ! read variable over domain 640 tl_var(jvar)=iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0) 641 642 il_offset(:,:)=grid_get_fine_offset(tl_coord0, & 643 & il_imin0, il_jmin0, & 644 & il_imax0, il_jmax0, & 645 & tl_coord1, & 646 & id_rho=il_rho(:), & 647 & cd_point=TRIM(tl_var(jvar)%c_point)) 648 649 650 ! interpolate variable 466 651 CALL create_restart_interp(tl_var(jvar), tl_level(:), & 467 652 & il_rho(:), & 468 653 & id_offset=il_offset(:,:)) 469 654 470 !tl_att=att_init('add_offset',0.) 471 !CALL var_move_att(tl_var(jvar), tl_att) 472 !tl_att=att_init('scale_factor',1.) 473 !CALL var_move_att(tl_var(jvar), tl_att) 474 475 !4-2-2-8 remove extraband added to domain 655 ! remove extraband added to domain 476 656 CALL dom_del_extra( tl_var(jvar), tl_dom0, il_rho(:) ) 477 657 478 ! 4-2-2-10add attribute to variable658 ! add attribute to variable 479 659 tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 480 660 CALL var_move_att(tl_var(jvar), tl_att) 481 661 662 tl_att=att_init('src_i-indices',(/il_imin0, il_imax0/)) 663 CALL var_move_att(tl_var(jvar), tl_att) 664 665 tl_att=att_init('src_j-indices',(/il_jmin0, il_jmax0/)) 666 CALL var_move_att(tl_var(jvar), tl_att) 667 668 IF( ANY(il_rho(:)/=1) )THEN 669 tl_att=att_init("refinment_factor", & 670 & (/il_rho(jp_I),il_rho(jp_J)/)) 671 CALL var_move_att(tl_var(jvar), tl_att) 672 ENDIF 673 482 674 ! clean structure 483 675 CALL att_clean(tl_att) 484 676 485 ! 4-2-2-11use mask677 ! use mask 486 678 CALL create_restart_mask(tl_var(jvar), tl_level(:)) 487 679 488 ! 4-2-2-12add ghost cell489 CALL grid_add_ghost( tl_var(jvar), &490 & tl_dom0%i_ighost,tl_dom0%i_jghost ) 680 ! add ghost cell 681 CALL grid_add_ghost( tl_var(jvar), il_xghost(:,:) ) 682 491 683 492 684 ENDDO 493 685 494 !4-2-2-2 close mpp file 495 CALL iom_mpp_close(tl_mpp) 686 ! close mpp file 687 CALL iom_dom_close(tl_mpp) 688 496 689 ! clean structure 497 690 CALL mpp_clean(tl_mpp) … … 500 693 ENDIF 501 694 502 ! close file503 CALL iom_close(tl_file)504 695 ! clean structure 505 CALL file_clean(tl_file)696 CALL mpp_clean(tl_mpp) 506 697 ENDIF 507 698 ENDDO 508 699 ENDIF 509 700 510 !5- use additional request 511 DO jvar=1,tl_multi%i_nvar 512 513 !5-1 forced min and max value 514 CALL var_limit_value(tl_var(jvar)) 515 516 !5-2 filter 517 CALL filter_fill_value(tl_var(jvar)) 518 519 !5-3 extrapolate 520 CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, & 521 & id_jext=in_extrap, & 522 & id_kext=in_extrap) 701 il_nvar=tl_multi%i_nvar 702 703 ! clean 704 CALL multi_clean(tl_multi) 705 CALL mpp_clean(tl_coord0) 706 707 ! use additional request 708 DO jvar=1,il_nvar 709 710 ! forced min and max value 711 CALL var_limit_value(tl_var(jvar)) 712 713 ! filter 714 CALL filter_fill_value(tl_var(jvar)) 715 716 ! extrapolate 717 CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, & 718 & id_jext=in_extrap, & 719 & id_kext=in_extrap) 523 720 524 721 ENDDO 525 722 526 ! 6-create file723 ! create file 527 724 IF( in_niproc == 0 .AND. & 528 725 & in_njproc == 0 .AND. & … … 532 729 in_nproc = 1 533 730 ENDIF 534 tl_mppout=mpp_init( TRIM(cn_fileout), tl_var(1), & 535 & in_niproc, in_njproc, in_nproc, & 536 & cd_type=cn_type) 537 538 !6-1 add dimension 731 732 ! add dimension 539 733 tl_dim(:)=var_max_dim(tl_var(:)) 734 735 DO ji=1,il_nvar 736 737 IF( ALL(tl_var(ji)%t_dim(:)%i_len == tl_dim(:)%i_len) )THEN 738 tl_mppout=mpp_init( TRIM(cn_fileout), tl_var(ji), & 739 & in_niproc, in_njproc, in_nproc, & 740 & cd_type=cn_type) 741 EXIT 742 ENDIF 743 744 ENDDO 540 745 541 746 DO ji=1,ip_maxdim … … 551 756 ENDDO 552 757 553 !6-2 add variables 554 555 !IF( ALL( tl_dim(1:2)%l_use ) )THEN 556 ! ! add longitude 557 ! tl_lon=iom_read_var(tl_coord1,'longitude') 558 559 ! CALL mpp_add_var(tl_mppout, tl_lon) 560 ! CALL var_clean(tl_lon) 561 562 ! ! add latitude 563 ! tl_lat=iom_read_var(tl_coord1,'latitude') 564 565 ! CALL mpp_add_var(tl_mppout, tl_lat) 566 ! CALL var_clean(tl_lat) 567 !ENDIF 568 569 !IF( tl_dim(3)%l_use )THEN 570 ! ! add depth 571 ! CALL mpp_add_var(tl_mppout, tl_depth) 572 ! CALL var_clean(tl_depth) 573 !ENDIF 574 575 !IF( tl_dim(4)%l_use )THEN 576 ! ! add time 577 ! CALL mpp_add_var(tl_mppout, tl_time) 578 ! CALL var_clean(tl_time) 579 !ENDIF 758 ! add variables 759 IF( ALL( tl_dim(1:2)%l_use ) )THEN 760 761 ! open mpp files 762 CALL iom_mpp_open(tl_coord1) 763 764 ! add longitude 765 tl_lon=iom_mpp_read_var(tl_coord1,'longitude') 766 CALL mpp_add_var(tl_mppout, tl_lon) 767 CALL var_clean(tl_lon) 768 769 ! add latitude 770 tl_lat=iom_mpp_read_var(tl_coord1,'latitude') 771 CALL mpp_add_var(tl_mppout, tl_lat) 772 CALL var_clean(tl_lat) 773 774 ! close mpp files 775 CALL iom_mpp_close(tl_coord1) 776 777 ENDIF 778 779 IF( tl_dim(3)%l_use )THEN 780 IF( ASSOCIATED(tl_depth%d_value) )THEN 781 ! add depth 782 CALL mpp_add_var(tl_mppout, tl_depth) 783 ELSE 784 CALL logger_error("CREATE RESTART: no value for depth variable.") 785 ENDIF 786 ENDIF 787 IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth) 788 789 IF( tl_dim(4)%l_use )THEN 790 IF( ASSOCIATED(tl_time%d_value) )THEN 791 ! add time 792 CALL mpp_add_var(tl_mppout, tl_time) 793 ELSE 794 CALL logger_error("CREATE RESTART: no value for time variable.") 795 ENDIF 796 ENDIF 797 IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time) 580 798 581 799 ! add other variable 582 DO jvar=1,tl_multi%i_nvar 583 CALL mpp_add_var(tl_mppout, tl_var(jvar)) 584 CALL var_clean(tl_var(jvar)) 800 DO jvar=1,il_nvar 801 ! check if variable already add 802 il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name) 803 IF( il_index == 0 )THEN 804 CALL mpp_add_var(tl_mppout, tl_var(jvar)) 805 CALL var_clean(tl_var(jvar)) 806 ENDIF 585 807 ENDDO 586 808 587 DO ji=1,4 588 CALL mpp_add_var(tl_mppout,tl_level(ji)) 589 ENDDO 590 591 !6-3 add some attribute 809 ! DO ji=1,4 810 ! CALL grid_add_ghost( tl_level(ji), il_xghost(:,:) ) 811 ! CALL var_clean(tl_level(ji)) 812 ! ENDDO 813 814 ! add some attribute 592 815 tl_att=att_init("Created_by","SIREN create_restart") 593 816 CALL mpp_add_att(tl_mppout, tl_att) … … 616 839 ENDIF 617 840 618 ! 6-4create file841 ! create file 619 842 CALL iom_mpp_create(tl_mppout) 620 843 621 ! 6-5write file844 ! write file 622 845 CALL iom_mpp_write_file(tl_mppout) 623 624 !6-6 close file 846 ! close file 625 847 CALL iom_mpp_close(tl_mppout) 626 IF( cn_coord0 /= '' ) CALL iom_close(tl_coord0) 627 628 !7- clean 848 849 ! print 850 CALL mpp_print(tl_mppout) 851 852 ! clean 853 CALL att_clean(tl_att) 854 CALL var_clean(tl_var(:)) 629 855 DEALLOCATE(tl_var) 856 CALL var_clean(tl_level(:)) 857 DEALLOCATE(tl_level) 630 858 631 859 CALL mpp_clean(tl_mppout) 632 CALL file_clean(tl_coord1) 633 CALL file_clean(tl_coord0) 860 CALL mpp_clean(tl_coord1) 634 861 635 862 ! close log file … … 637 864 CALL logger_close() 638 865 639 !> @endcode640 866 CONTAINS 641 !-------------------------------------------------------------------642 !> @brief643 !>644 !> @details645 !>646 !> @author J.Paul647 !> - Nov, 2013- Initial Version648 !>649 !-------------------------------------------------------------------650 !> @code651 FUNCTION create_restart_level(td_level1)652 IMPLICIT NONE653 ! Argument654 TYPE(TFILE), INTENT(IN) :: td_level1655 656 ! function657 TYPE(TVAR), DIMENSION(4) :: create_restart_level658 659 ! local variable660 TYPE(TFILE) :: tl_level1661 TYPE(TVAR), DIMENSION(4) :: tl_var662 TYPE(TMPP) :: tl_mpplevel1663 664 ! loop indices665 !----------------------------------------------------------------666 667 !0- compute domain668 tl_dom1=dom_init(td_level1)669 670 !1 init mpp structure671 tl_level1=td_level1672 tl_mpplevel1=mpp_init(tl_level1)673 674 CALL file_clean(tl_level1)675 676 !2 get processor to be used677 CALL mpp_get_use( tl_mpplevel1, tl_dom1 )678 679 !3 open mpp files680 CALL iom_mpp_open(tl_mpplevel1)681 tl_var(jp_T)=iom_mpp_read_var(tl_mpplevel1,'tlevel',td_dom=tl_dom1)682 tl_var(jp_U)=iom_mpp_read_var(tl_mpplevel1,'ulevel',td_dom=tl_dom1)683 tl_var(jp_V)=iom_mpp_read_var(tl_mpplevel1,'vlevel',td_dom=tl_dom1)684 tl_var(jp_F)=iom_mpp_read_var(tl_mpplevel1,'flevel',td_dom=tl_dom1)685 686 !4 save result687 create_restart_level(:)=tl_var(:)688 689 !5 clean690 CALL iom_mpp_close(tl_mpplevel1)691 CALL mpp_clean(tl_mpplevel1)692 693 END FUNCTION create_restart_level694 !> @endcode695 867 !------------------------------------------------------------------- 696 868 !> @brief … … 699 871 !> @details 700 872 !> A variable is create with the same name that the input variable, 701 !> and with dimension of the coordinate file. 702 !> Then the variable tableof value is split into equal subdomain.703 !> Each subdomain is fill with the linkedvalue of the matrix.873 !> and with dimension of the coordinate file.<br/> 874 !> Then the variable array of value is split into equal subdomain. 875 !> Each subdomain is filled with the corresponding value of the matrix. 704 876 !> 705 877 !> @author J.Paul 706 !> - Nov , 2013- Initial Version878 !> - November, 2013- Initial Version 707 879 !> 708 !> @param[in] td_var : variable structure 709 !> @param[in] td_coord : coordinate 880 !> @param[in] td_var variable structure 881 !> @param[in] td_coord coordinate file structure 882 !> @param[in] id_nlevel number of vertical level 883 !> @param[in] td_level array of level on T,U,V,F point (variable structure) 710 884 !> @return variable structure 711 885 !------------------------------------------------------------------- 712 !> @code 713 FUNCTION create_restart_matrix(td_var, td_coord) 886 FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, td_level) 714 887 IMPLICIT NONE 715 888 ! Argument 716 TYPE(TVAR) , INTENT(IN) :: td_var 717 TYPE(TFILE), INTENT(IN) :: td_coord 889 TYPE(TVAR) , INTENT(IN) :: td_var 890 TYPE(TMPP) , INTENT(IN) :: td_coord 891 INTEGER(i4) , INTENT(IN) :: id_nlevel 892 TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level 718 893 719 894 ! function … … 721 896 722 897 ! local variable 723 INTEGER(i4) :: il_ighost724 INTEGER(i4) :: il_jghost725 INTEGER(i4) , DIMENSION(2) :: il_xghost726 898 INTEGER(i4) , DIMENSION(3) :: il_dim 727 899 INTEGER(i4) , DIMENSION(3) :: il_size 728 900 INTEGER(i4) , DIMENSION(3) :: il_rest 901 INTEGER(i4) , DIMENSION(2,2) :: il_xghost 729 902 730 903 INTEGER(i4) , DIMENSION(:) , ALLOCATABLE :: il_ishape … … 734 907 REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 735 908 736 TYPE(TVAR) :: tl_lon737 TYPE(TVAR) :: tl_lat738 TYPE(TVAR) :: tl_var739 909 TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim 740 910 … … 745 915 !---------------------------------------------------------------- 746 916 747 !1- read output grid 748 tl_lon=iom_read_var(td_coord,'longitude') 749 tl_lat=iom_read_var(td_coord,'latitude') 750 751 !2- look for ghost cell 752 il_xghost(:)=grid_get_ghost( tl_lon, tl_lat ) 753 754 il_ighost=il_xghost(1)*ig_ghost 755 il_jghost=il_xghost(2)*ig_ghost 756 757 !3- write value on grid 758 !3-1 get matrix dimension 917 ! look for ghost cell 918 il_xghost(:,:)=grid_get_ghost( td_coord ) 919 920 ! write value on grid 921 ! get matrix dimension 759 922 il_dim(:)=td_var%t_dim(1:3)%i_len 760 !3-2 output dimension 761 tl_dim(:)=tl_lon%t_dim(:) 923 924 ! output dimension 925 tl_dim(jp_I:jp_J)=dim_copy(td_coord%t_dim(jp_I:jp_J)) 926 IF( id_nlevel >= 1 )THEN 927 tl_dim(jp_K)=dim_init('Z',id_nlevel) 928 ENDIF 762 929 763 930 ! remove ghost cell 764 tl_dim( 1)%i_len=tl_dim(1)%i_len - 2*il_xghost(1)*ig_ghost765 tl_dim( 2)%i_len=tl_dim(2)%i_len - 2*il_xghost(2)*ig_ghost766 767 ! 3-3split output domain in N subdomain depending of matrix dimension931 tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(il_xghost(jp_I,:))*ip_ghost 932 tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(il_xghost(jp_J,:))*ip_ghost 933 934 ! split output domain in N subdomain depending of matrix dimension 768 935 il_size(:) = tl_dim(1:3)%i_len / il_dim(:) 769 936 il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:)) … … 776 943 ! add rest to last cell 777 944 il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1) 778 779 945 780 946 ALLOCATE( il_jshape(il_dim(2)+1) ) … … 794 960 il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3) 795 961 796 ! 3-3 write ouput tableof value962 ! write ouput array of value 797 963 ALLOCATE(dl_value( tl_dim(1)%i_len, & 798 964 & tl_dim(2)%i_len, & … … 815 981 ENDDO 816 982 817 !3-4 initialise variable with value 818 tl_var=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:)) 983 ! keep attribute and type 984 create_restart_matrix=var_copy(td_var) 985 DEALLOCATE( create_restart_matrix%d_value ) 986 ! save new dimension 987 create_restart_matrix%t_dim(:)=dim_copy(tl_dim(:)) 988 ! add variable value 989 CALL var_add_value( create_restart_matrix, dl_value(:,:,:,:), & 990 & id_type=td_var%i_type) 819 991 820 992 DEALLOCATE(dl_value) 821 993 822 !4- add ghost cell 823 CALL grid_add_ghost(tl_var,il_ighost,il_jghost) 824 825 !5- save result 826 create_restart_matrix=tl_var 994 ! use mask 995 CALL create_restart_mask(create_restart_matrix, td_level(:)) 996 997 ! add ghost cell 998 CALL grid_add_ghost( create_restart_matrix, il_xghost(:,:) ) 999 1000 ! clean 1001 DEALLOCATE(il_ishape) 1002 DEALLOCATE(il_jshape) 1003 DEALLOCATE(il_kshape) 827 1004 828 1005 END FUNCTION create_restart_matrix 829 !> @endcode830 1006 !------------------------------------------------------------------- 831 1007 !> @brief 1008 !> This subroutine use mask to filled land point with _FillValue 832 1009 !> 833 !> @details 1010 !> @author J.Paul 1011 !> - November, 2013- Initial Version 834 1012 !> 835 !> @author J.Paul 836 !> - Nov, 2013- Initial Version 837 !> 1013 !> @param[inout] td_var variable structure 1014 !> @param[in] td_mask mask variable structure 838 1015 !------------------------------------------------------------------- 839 !> @code840 FUNCTION create__restart_get_dom_coord( td_file, td_coord, &841 & id_rho )842 IMPLICIT NONE843 ! Argument844 TYPE(TFILE), INTENT(IN) :: td_file845 TYPE(TFILE), INTENT(IN) :: td_coord846 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho847 848 ! function849 TYPE(TDOM) :: create__restart_get_dom_coord850 851 ! local variable852 INTEGER(i4) :: il_pivot853 INTEGER(i4) :: il_perio854 855 INTEGER(i4) :: il_imin856 INTEGER(i4) :: il_imax857 INTEGER(i4) :: il_jmin858 INTEGER(i4) :: il_jmax859 860 INTEGER(i4), DIMENSION(2,2,2) :: il_ind861 862 TYPE(TFILE) :: tl_file863 864 TYPE(TDOM) :: tl_dom865 ! loop indices866 !----------------------------------------------------------------867 868 tl_file=td_file869 !1- open file870 CALL iom_open(tl_file)871 872 ! get periodicity873 il_pivot=grid_get_pivot(tl_file)874 il_perio=grid_get_perio(tl_file,il_pivot)875 876 tl_file%i_perio=il_perio877 878 !2- compute file grid indices around coord grid879 il_ind(:,:,:)=grid_get_coarse_index(tl_file, td_coord )880 881 il_imin=il_ind(1,1,1) ; il_imax=il_ind(1,2,1)882 il_jmin=il_ind(2,1,1) ; il_jmax=il_ind(2,2,1)883 884 !3- check grid coincidence885 CALL grid_check_coincidence( tl_file, td_coord, &886 & il_imin, il_imax, &887 & il_jmin, il_jmax, &888 & id_rho(:) )889 890 !4- compute domain891 tl_dom=dom_init(tl_file, &892 & il_imin, il_imax, &893 & il_jmin, il_jmax)894 895 ! close file896 CALL iom_close(tl_file)897 898 ! save result899 create__restart_get_dom_coord=tl_dom900 901 END FUNCTION create__restart_get_dom_coord902 !> @endcode903 !-------------------------------------------------------------------904 !> @brief905 !>906 !> @details907 !>908 !> @author J.Paul909 !> - Nov, 2013- Initial Version910 !>911 !-------------------------------------------------------------------912 !> @code913 FUNCTION create__restart_get_dom_index( td_file, id_imin, id_jmin, &914 & id_imax, id_jmax )915 IMPLICIT NONE916 ! Argument917 TYPE(TFILE), INTENT(IN) :: td_file918 INTEGER(i4), INTENT(IN) :: id_imin919 INTEGER(i4), INTENT(IN) :: id_imax920 INTEGER(i4), INTENT(IN) :: id_jmin921 INTEGER(i4), INTENT(IN) :: id_jmax922 923 ! function924 TYPE(TDOM) :: create__restart_get_dom_index925 926 ! local variable927 INTEGER(i4) :: il_pivot928 INTEGER(i4) :: il_perio929 930 TYPE(TFILE) :: tl_file931 932 TYPE(TDOM) :: tl_dom933 ! loop indices934 !----------------------------------------------------------------935 936 ! init937 tl_file=td_file938 !1- open file939 CALL iom_open(tl_file)940 941 ! get periodicity942 il_pivot=grid_get_pivot(tl_file)943 il_perio=grid_get_perio(tl_file,il_pivot)944 945 tl_file%i_perio=il_perio946 947 !2- compute domain948 tl_dom=dom_init(tl_file, &949 & id_imin, id_imax, &950 & id_jmin, id_jmax)951 952 ! close file953 CALL iom_close(tl_file)954 955 ! save result956 create__restart_get_dom_index=tl_dom957 958 END FUNCTION create__restart_get_dom_index959 !> @endcode960 !-------------------------------------------------------------------961 !> @brief962 !> This subroutine963 !>964 !> @details965 !>966 !> @author J.Paul967 !> - Nov, 2013- Initial Version968 !>969 !> @param[in]970 !> @todo971 !-------------------------------------------------------------------972 !> @code973 1016 SUBROUTINE create_restart_mask( td_var, td_mask ) 974 1017 … … 987 1030 !---------------------------------------------------------------- 988 1031 989 IF( A NY(td_var%t_dim(1:2)%i_len /= td_mask(1)%t_dim(1:2)%i_len) )THEN990 CALL logger_error("CREATE RESTART MASK: dimension differ between "//&991 & "variable ("//&992 & TRIM(fct_str(td_var%t_dim(1)%i_len))//","//&993 & TRIM(fct_str(td_var%t_dim(2)%i_len))//&994 & ") and level ("//&995 & TRIM(fct_str(td_mask(1)%t_dim(1)%i_len))//","//&996 & TRIM(fct_str(td_mask(1)%t_dim(2)%i_len))//")")997 ELSE998 ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &999 & td_var%t_dim(2)%i_len) )1000 1001 SELECT CASE(TRIM(td_var%c_point)) 1002 CASE('T')1003 il_mask(:,:)=INT(td_mask(jp_T)%d_value(:,:,1,1))1004 CASE('U')1005 il_mask(:,:)=INT(td_mask(jp_U)%d_value(:,:,1,1))1006 CASE('V')1007 il_mask(:,:)=INT(td_mask(jp_V)%d_value(:,:,1,1))1008 CASE('F')1009 il_mask(:,:)=INT(td_mask(jp_F)%d_value(:,:,1,1))1010 END SELECT1011 1012 DO jl=1,td_var%t_dim(4)%i_len 1013 DO j k=1,td_var%t_dim(3)%i_len1014 WHERE( il_mask(:,:) < jk ) td_var%d_value(:,:,jk,jl)=99 !td_var%d_fill1015 !.AND. &1016 !& td_var%d_value(:,:,jk,jl) == td_var%d_fill .OR. &1017 !& il_mask(:,:) < jk .AND. &1018 !& td_var%d_value(:,:,jk,jl) == 1 ) td_var%d_value(:,:,jk,jl)=99 !td_var%d_fill1032 IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 1033 IF( ANY(td_var%t_dim(1:2)%i_len /= td_mask(1)%t_dim(1:2)%i_len) )THEN 1034 CALL logger_error("CREATE RESTART MASK: dimension differ between"//& 1035 & " variable "//TRIM(td_var%c_name)//" ("//& 1036 & TRIM(fct_str(td_var%t_dim(1)%i_len))//","//& 1037 & TRIM(fct_str(td_var%t_dim(2)%i_len))//& 1038 & ") and level ("//& 1039 & TRIM(fct_str(td_mask(1)%t_dim(1)%i_len))//","//& 1040 & TRIM(fct_str(td_mask(1)%t_dim(2)%i_len))//")") 1041 ELSE 1042 ALLOCATE( il_mask(td_var%t_dim(1)%i_len, & 1043 & td_var%t_dim(2)%i_len) ) 1044 1045 SELECT CASE(TRIM(td_var%c_point)) 1046 CASE('T') 1047 il_mask(:,:)=INT(td_mask(jp_T)%d_value(:,:,1,1)) 1048 CASE('U') 1049 il_mask(:,:)=INT(td_mask(jp_U)%d_value(:,:,1,1)) 1050 CASE('V') 1051 il_mask(:,:)=INT(td_mask(jp_V)%d_value(:,:,1,1)) 1052 CASE('F') 1053 il_mask(:,:)=INT(td_mask(jp_F)%d_value(:,:,1,1)) 1054 END SELECT 1055 1056 DO jl=1,td_var%t_dim(4)%i_len 1057 DO jk=1,td_var%t_dim(3)%i_len 1058 WHERE( il_mask(:,:) < jk ) 1059 td_var%d_value(:,:,jk,jl)=td_var%d_fill 1060 END WHERE 1061 ENDDO 1019 1062 ENDDO 1020 ENDDO 1021 1022 DEALLOCATE( il_mask )1063 1064 DEALLOCATE( il_mask ) 1065 ENDIF 1023 1066 ENDIF 1024 1067 END SUBROUTINE create_restart_mask 1025 !> @endcode1026 1068 !------------------------------------------------------------------- 1027 1069 !> @brief 1028 !> This subroutine 1070 !> This subroutine interpolate variable 1029 1071 !> 1030 !> @details1031 !>1032 1072 !> @author J.Paul 1033 1073 !> - Nov, 2013- Initial Version 1034 1074 !> 1035 !> @param[in] 1075 !> @param[inout] td_var variable structure 1076 !> @param[inout] td_level fine grid level, array of variable structure 1077 !> @param[in] id_rho array of refinment factor 1078 !> @param[in] id_offset array of offset between fine and coarse grid 1079 !> @param[in] id_iext i-direction size of extra bands (default=im_minext) 1080 !> @param[in] id_jext j-direction size of extra bands (default=im_minext) 1036 1081 !------------------------------------------------------------------- 1037 !> @code1038 FUNCTION create_restart_extract(td_var, td_file, &1039 & td_coord)1040 IMPLICIT NONE1041 ! Argument1042 TYPE(TVAR) , INTENT(IN) :: td_var1043 TYPE(TFILE), INTENT(IN) :: td_file1044 TYPE(TFILE), INTENT(IN) :: td_coord1045 1046 ! function1047 TYPE(TVAR) :: create_restart_extract1048 1049 ! local variable1050 INTEGER(i4), DIMENSION(2,2,2) :: il_ind1051 1052 INTEGER(i4) :: il_pivot1053 INTEGER(i4) :: il_perio1054 1055 INTEGER(i4) :: il_imin1056 INTEGER(i4) :: il_jmin1057 INTEGER(i4) :: il_imax1058 INTEGER(i4) :: il_jmax1059 1060 TYPE(TFILE) :: tl_file1061 1062 TYPE(TMPP) :: tl_mpp1063 1064 TYPE(TATT) :: tl_att1065 1066 TYPE(TVAR) :: tl_var1067 1068 TYPE(TDOM) :: tl_dom1069 ! loop indices1070 !----------------------------------------------------------------1071 1072 IF( td_file%i_id == 0 )THEN1073 CALL logger_error("CREATE RESTART EXTRACT: file "//&1074 & TRIM(td_file%c_name)//" not opened ")1075 ELSE1076 1077 !init1078 tl_file=td_file1079 1080 !1- open file1081 CALL iom_open(tl_file)1082 1083 ! get periodicity1084 il_pivot=grid_get_pivot(tl_file)1085 il_perio=grid_get_perio(tl_file,il_pivot)1086 1087 tl_file%i_perio=il_perio1088 1089 !2- compute file grid indices around coord grid1090 il_ind(:,:,:)=grid_get_coarse_index(tl_file, td_coord )1091 1092 il_imin=il_ind(1,1,1) ; il_imax=il_ind(1,2,1)1093 il_jmin=il_ind(2,1,1) ; il_jmax=il_ind(2,2,1)1094 1095 !3- check grid coincidence1096 CALL grid_check_coincidence( tl_file, td_coord, &1097 & il_imin, il_imax, &1098 & il_jmin, il_jmax, &1099 & (/1, 1, 1/) )1100 1101 !4- compute domain1102 tl_dom=dom_init(tl_file, &1103 & il_imin, il_imax, &1104 & il_jmin, il_jmax)1105 1106 ! close file1107 CALL iom_close(tl_file)1108 1109 !5- read bathymetry on domain (ugly way to do it, have to work on it)1110 !5-1 init mpp structure1111 tl_mpp=mpp_init(tl_file)1112 1113 CALL file_clean(tl_file)1114 1115 !5-2 get processor to be used1116 CALL mpp_get_use( tl_mpp, tl_dom )1117 1118 !5-3 open mpp files1119 CALL iom_mpp_open(tl_mpp)1120 1121 !5-4 read variable on domain1122 tl_var=iom_mpp_read_var(tl_mpp,TRIM(td_var%c_name),td_dom=tl_dom)1123 1124 !5-5 close mpp file1125 CALL iom_mpp_close(tl_mpp)1126 1127 !6- add ghost cell1128 CALL grid_add_ghost(tl_var,tl_dom%i_ighost,tl_dom%i_jghost)1129 1130 !7- check result1131 IF( ANY( tl_var%t_dim(:)%l_use .AND. &1132 & tl_var%t_dim(:)%i_len /= td_coord%t_dim(:)%i_len) )THEN1133 CALL logger_debug("CREATE BATHY EXTRACT: "//&1134 & "dimensoin of variable "//TRIM(td_var%c_name)//" "//&1135 & TRIM(fct_str(tl_var%t_dim(1)%i_len))//","//&1136 & TRIM(fct_str(tl_var%t_dim(2)%i_len))//","//&1137 & TRIM(fct_str(tl_var%t_dim(3)%i_len))//","//&1138 & TRIM(fct_str(tl_var%t_dim(4)%i_len)) )1139 CALL logger_debug("CREATE BATHY EXTRACT: "//&1140 & "dimensoin of coordinate file "//&1141 & TRIM(fct_str(td_coord%t_dim(1)%i_len))//","//&1142 & TRIM(fct_str(td_coord%t_dim(2)%i_len))//","//&1143 & TRIM(fct_str(td_coord%t_dim(3)%i_len))//","//&1144 & TRIM(fct_str(td_coord%t_dim(4)%i_len)) )1145 CALL logger_fatal("CREATE BATHY EXTRACT: "//&1146 & "dimensoin of extracted "//&1147 & "variable and coordinate file dimension differ")1148 ENDIF1149 1150 !8- add attribute to variable1151 tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))1152 CALL var_move_att(tl_var, tl_att)1153 1154 !9- save result1155 create_restart_extract=tl_var1156 1157 ! clean structure1158 CALL var_clean(tl_var)1159 CALL mpp_clean(tl_mpp)1160 ENDIF1161 1162 END FUNCTION create_restart_extract1163 !> @endcode1164 !-------------------------------------------------------------------1165 !> @brief1166 !> This subroutine1167 !>1168 !> @details1169 !>1170 !> @author J.Paul1171 !> - Nov, 2013- Initial Version1172 !>1173 !> @param[in]1174 !> @todo1175 !-------------------------------------------------------------------1176 !> @code1177 1082 SUBROUTINE create_restart_interp( td_var, td_level,& 1178 1083 & id_rho, & … … 1191 1096 1192 1097 ! local variable 1193 TYPE(TVAR) :: tl_var1194 1195 1098 INTEGER(i4) :: il_iext 1196 1099 INTEGER(i4) :: il_jext … … 1198 1101 ! loop indices 1199 1102 !---------------------------------------------------------------- 1200 1201 ! copy variable1202 tl_var=td_var1203 1103 1204 1104 il_iext=3 … … 1220 1120 ENDIF 1221 1121 1222 il_iext=01223 il_jext=01224 1225 1122 ! work on variable 1226 ! 1add extraband1227 CALL extrap_add_extrabands(t l_var, il_iext, il_jext)1228 1229 ! 2extrapolate variable1230 CALL extrap_fill_value( t l_var, td_level(:), &1123 ! add extraband 1124 CALL extrap_add_extrabands(td_var, il_iext, il_jext) 1125 1126 ! extrapolate variable 1127 CALL extrap_fill_value( td_var, td_level(:), & 1231 1128 & id_offset(:,:), & 1232 1129 & id_rho(:), & 1233 1130 & id_iext=il_iext, id_jext=il_jext ) 1234 1131 1235 ! 3interpolate variable1236 CALL interp_fill_value( t l_var, id_rho(:), &1132 ! interpolate variable 1133 CALL interp_fill_value( td_var, id_rho(:), & 1237 1134 & id_offset=id_offset(:,:) ) 1238 1135 1239 !4 remove extraband 1240 CALL extrap_del_extrabands(tl_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 1241 1242 !5- save result 1243 td_var=tl_var 1244 1245 ! clean variable structure 1246 CALL var_clean(tl_var) 1136 ! remove extraband 1137 CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 1247 1138 1248 1139 END SUBROUTINE create_restart_interp 1249 !> @endcode 1140 !------------------------------------------------------------------- 1141 !> @brief 1142 !> This subroutine get depth variable value in an open mpp structure 1143 !> and check if agree with already input depth variable. 1144 !> 1145 !> @details 1146 !> 1147 !> @author J.Paul 1148 !> - November, 2014- Initial Version 1149 !> 1150 !> @param[in] td_mpp mpp structure 1151 !> @param[inout] td_depth depth variable structure 1152 !------------------------------------------------------------------- 1153 SUBROUTINE create_restart_check_depth( td_mpp, td_depth ) 1154 1155 IMPLICIT NONE 1156 1157 ! Argument 1158 TYPE(TMPP), INTENT(IN ) :: td_mpp 1159 TYPE(TVAR), INTENT(INOUT) :: td_depth 1160 1161 ! local variable 1162 INTEGER(i4) :: il_varid 1163 TYPE(TVAR) :: tl_depth 1164 ! loop indices 1165 !---------------------------------------------------------------- 1166 1167 ! get or check depth value 1168 IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN 1169 1170 il_varid=td_mpp%t_proc(1)%i_depthid 1171 IF( ASSOCIATED(td_depth%d_value) )THEN 1172 1173 tl_depth=iom_mpp_read_var(td_mpp, il_varid) 1174 IF( ANY( td_depth%d_value(:,:,:,:) /= & 1175 & tl_depth%d_value(:,:,:,:) ) )THEN 1176 1177 CALL logger_fatal("CREATE BOUNDARY: depth value from "//& 1178 & TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 1179 & " to those from former file(s).") 1180 1181 ENDIF 1182 CALL var_clean(tl_depth) 1183 1184 ELSE 1185 td_depth=iom_mpp_read_var(td_mpp,il_varid) 1186 ENDIF 1187 1188 ENDIF 1189 1190 END SUBROUTINE create_restart_check_depth 1191 !------------------------------------------------------------------- 1192 !> @brief 1193 !> This subroutine get date and time in an open mpp structure 1194 !> and check if agree with date and time already read. 1195 !> 1196 !> @details 1197 !> 1198 !> @author J.Paul 1199 !> - November, 2014- Initial Version 1200 !> 1201 !> @param[in] td_mpp mpp structure 1202 !> @param[inout] td_time time variable structure 1203 !------------------------------------------------------------------- 1204 SUBROUTINE create_restart_check_time( td_mpp, td_time ) 1205 1206 IMPLICIT NONE 1207 1208 ! Argument 1209 TYPE(TMPP), INTENT(IN ) :: td_mpp 1210 TYPE(TVAR), INTENT(INOUT) :: td_time 1211 1212 ! local variable 1213 INTEGER(i4) :: il_varid 1214 TYPE(TVAR) :: tl_time 1215 1216 TYPE(TDATE) :: tl_date1 1217 TYPE(TDATE) :: tl_date2 1218 ! loop indices 1219 !---------------------------------------------------------------- 1220 1221 ! get or check depth value 1222 IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 1223 1224 il_varid=td_mpp%t_proc(1)%i_timeid 1225 IF( ASSOCIATED(td_time%d_value) )THEN 1226 1227 tl_time=iom_mpp_read_var(td_mpp, il_varid) 1228 1229 tl_date1=var_to_date(td_time) 1230 tl_date2=var_to_date(tl_time) 1231 IF( tl_date1 - tl_date2 /= 0 )THEN 1232 1233 CALL logger_fatal("CREATE BOUNDARY: date from "//& 1234 & TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 1235 & " to those from former file(s).") 1236 1237 ENDIF 1238 CALL var_clean(tl_time) 1239 1240 ELSE 1241 td_time=iom_mpp_read_var(td_mpp,il_varid) 1242 ENDIF 1243 1244 ENDIF 1245 1246 END SUBROUTINE create_restart_check_time 1250 1247 END PROGRAM create_restart
Note: See TracChangeset
for help on using the changeset viewer.