Changeset 12080 for utils/tools/SIREN/src/multi.f90
- Timestamp:
- 2019-12-06T10:30:14+01:00 (4 years ago)
- File:
-
- 1 edited
-
utils/tools/SIREN/src/multi.f90 (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
utils/tools/SIREN/src/multi.f90
r9598 r12080 3 3 !---------------------------------------------------------------------- 4 4 ! 5 ! MODULE: multi6 !7 5 ! DESCRIPTION: 8 6 !> This module manage multi file structure. 9 ! 7 !> 10 8 !> @details 11 9 !> define type TMULTI:<br/> … … 57 55 !> @author 58 56 !> J.Paul 59 ! REVISION HISTORY:57 !> 60 58 !> @date November, 2013 - Initial Version 61 59 !> @date October, 2014 … … 63 61 !> @date November, 2014 64 62 !> - Fix memory leaks bug 65 ! 66 !> @note Software governed by the CeCILL licence ( ./LICENSE)63 !> 64 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 67 65 !---------------------------------------------------------------------- 68 66 MODULE multi 67 69 68 USE kind ! F90 kind parameter 70 69 USE logger ! log file manager … … 89 88 PUBLIC :: multi_print !< print information about milti structure 90 89 91 P UBLIC :: multi__add_mpp!< add file strucutre to multi file structure90 PRIVATE :: multi__add_mpp !< add file strucutre to multi file structure 92 91 PRIVATE :: multi__copy_unit !< copy multi file structure 92 PRIVATE :: multi__get_perio !< read periodicity from namelist 93 93 94 94 TYPE TMULTI !< multi file structure … … 104 104 105 105 CONTAINS 106 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 107 FUNCTION multi__copy_unit(td_multi) & 108 & RESULT (tf_multi) 106 109 !------------------------------------------------------------------- 107 110 !> @brief … … 126 129 !> @return copy of input multi structure 127 130 !------------------------------------------------------------------- 128 FUNCTION multi__copy_unit( td_multi ) 131 129 132 IMPLICIT NONE 133 130 134 ! Argument 131 135 TYPE(TMULTI), INTENT(IN) :: td_multi 136 132 137 ! function 133 TYPE(TMULTI) :: multi__copy_unit138 TYPE(TMULTI) :: tf_multi 134 139 135 140 ! local variable … … 140 145 !---------------------------------------------------------------- 141 146 142 multi__copy_unit%i_nmpp = td_multi%i_nmpp143 multi__copy_unit%i_nvar = td_multi%i_nvar147 tf_multi%i_nmpp = td_multi%i_nmpp 148 tf_multi%i_nvar = td_multi%i_nvar 144 149 145 150 ! copy variable structure 146 IF( ASSOCIATED( multi__copy_unit%t_mpp) )THEN147 CALL mpp_clean( multi__copy_unit%t_mpp(:))148 DEALLOCATE( multi__copy_unit%t_mpp)151 IF( ASSOCIATED(tf_multi%t_mpp) )THEN 152 CALL mpp_clean(tf_multi%t_mpp(:)) 153 DEALLOCATE(tf_multi%t_mpp) 149 154 ENDIF 150 IF( ASSOCIATED(td_multi%t_mpp) .AND. multi__copy_unit%i_nmpp > 0 )THEN151 ALLOCATE( multi__copy_unit%t_mpp(multi__copy_unit%i_nmpp) )152 DO ji=1, multi__copy_unit%i_nmpp155 IF( ASSOCIATED(td_multi%t_mpp) .AND. tf_multi%i_nmpp > 0 )THEN 156 ALLOCATE( tf_multi%t_mpp(tf_multi%i_nmpp) ) 157 DO ji=1,tf_multi%i_nmpp 153 158 tl_mpp = mpp_copy(td_multi%t_mpp(ji)) 154 multi__copy_unit%t_mpp(ji) = mpp_copy(tl_mpp)159 tf_multi%t_mpp(ji) = mpp_copy(tl_mpp) 155 160 ENDDO 156 161 ! clean … … 159 164 160 165 END FUNCTION multi__copy_unit 166 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 167 FUNCTION multi_init(cd_varfile) & 168 & RESULT (tf_multi) 161 169 !------------------------------------------------------------------- 162 170 !> @brief This subroutine initialize multi file structure. … … 165 173 !> if variable name is 'all', add all the variable of the file in mutli file 166 174 !> structure. 175 !> Optionnaly, periodicity could be read behind filename. 176 !> 167 177 !> @note if first character of filename is numeric, assume matrix is given as 168 178 !> input.<br/> … … 175 185 !> @date January, 2016 176 186 !> - read variable dimensions 187 !> @date July, 2016 188 !> - get variable to be read and associated file first 189 !> @date August, 2017 190 !> - get perio from namelist 191 !> @date January, 2019 192 !> - create and clean file structure to avoid memory leaks 193 !> - fill value read from array of variable structure 194 !> @date May, 2019 195 !> - compare each elt of cl_tabfile to cl_file 196 !> @date August, 2019 197 !> - use periodicity read from namelist, and store in multi structure 177 198 !> 178 199 !> @param[in] cd_varfile variable location information (from namelist) 179 200 !> @return multi file structure 180 201 !------------------------------------------------------------------- 181 FUNCTION multi_init(cd_varfile) 202 182 203 IMPLICIT NONE 183 204 … … 186 207 187 208 ! function 188 TYPE(TMULTI) :: multi_init 209 TYPE(TMULTI) :: tf_multi 210 211 ! parameters 212 INTEGER(i4) , PARAMETER :: ip_nmaxfiles = 50 213 INTEGER(i4) , PARAMETER :: ip_nmaxvars = 100 189 214 190 215 ! local variable 191 CHARACTER(LEN=lc) :: cl_name 192 CHARACTER(LEN=lc) :: cl_lower 193 CHARACTER(LEN=lc) :: cl_file 194 CHARACTER(LEN=lc) :: cl_matrix 195 196 INTEGER(i4) :: il_nvar 197 INTEGER(i4) :: il_varid 198 199 LOGICAL :: ll_dim 200 201 TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim 202 203 TYPE(TVAR) :: tl_var 204 205 TYPE(TMPP) :: tl_mpp 216 INTEGER(i4) :: il_nvar 217 INTEGER(i4) :: il_nvarin 218 INTEGER(i4) :: il_nfiles 219 INTEGER(i4) :: il_varid 220 INTEGER(i4) :: il_perio 221 222 REAL(dp) :: dl_fill 223 CHARACTER(LEN=lc) :: cl_name 224 CHARACTER(LEN=lc) :: cl_varname 225 CHARACTER(LEN=lc) :: cl_lower 226 CHARACTER(LEN=lc) :: cl_file 227 CHARACTER(LEN=lc) :: cl_matrix 228 229 CHARACTER(LEN=lc), DIMENSION(ip_nmaxfiles) :: cl_tabfile 230 CHARACTER(LEN=lc), DIMENSION(ip_nmaxfiles, ip_nmaxvars) :: cl_tabvar 231 232 LOGICAL :: ll_dim 233 234 TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim 235 236 TYPE(TVAR) :: tl_var 237 TYPE(TVAR) , DIMENSION(:), ALLOCATABLE :: tl_varin 238 239 TYPE(TMPP) :: tl_mpp 240 241 TYPE(TFILE) :: tl_file 206 242 207 243 ! loop indices … … 209 245 INTEGER(i4) :: jj 210 246 INTEGER(i4) :: jk 247 INTEGER(i4) :: jl 248 INTEGER(i4) :: jf 249 INTEGER(i4) , DIMENSION(ip_nmaxvars) :: jv 211 250 !---------------------------------------------------------------- 212 251 213 252 ji=1 253 jf=0 254 jv(:)=0 255 cl_tabfile(:)='' 214 256 DO WHILE( TRIM(cd_varfile(ji)) /= '' ) 215 257 216 il_nvar=0217 258 cl_name=fct_split(cd_varfile(ji),1,':') 218 cl_lower=fct_lower(cl_name) 259 IF( TRIM(cl_name) == '' )THEN 260 CALL logger_error("MULTI INIT: variable name "//& 261 & "is empty. check namelist.") 262 ENDIF 263 219 264 cl_file=fct_split(cd_varfile(ji),2,':') 220 221 IF( LEN(TRIM(cl_file)) == lc )THEN 265 IF( TRIM(cl_file) == '' )THEN 266 CALL logger_error("MULTI INIT: file name matching variable "//& 267 & TRIM(cl_name)//" is empty. check namelist.") 268 ENDIF 269 IF( LEN(TRIM(cl_file)) >= lc )THEN 222 270 CALL logger_fatal("MULTI INIT: file name too long (>"//& 223 271 & TRIM(fct_str(lc))//"). check namelist.") 224 272 ENDIF 225 226 IF( TRIM(cl_lower) /= '' )THEN 227 IF( TRIM(cl_file) /= '' )THEN 228 cl_matrix='' 229 IF( fct_is_num(cl_file(1:1)) )THEN 230 cl_matrix=TRIM(cl_file) 231 WRITE(cl_file,'(a,i2.2)')'data-',ji 232 233 tl_var=var_init(TRIM(cl_name)) 234 CALL var_read_matrix(tl_var, cl_matrix) 235 273 274 IF( TRIM(cl_file) /= '' )THEN 275 jk=0 276 DO jj=1,jf 277 IF( TRIM(cl_file) == TRIM(cl_tabfile(jj)) )THEN 278 jk=jj 279 EXIT 280 ENDIF 281 ENDDO 282 IF ( jk /= 0 )then 283 jv(jk)=jv(jk)+1 284 cl_tabvar(jk,jv(jk))=TRIM(cl_name) 285 ELSE ! jk == 0 286 jf=jf+1 287 IF( jf > ip_nmaxfiles )THEN 288 CALL logger_fatal("MULTI INIT: too much files in "//& 289 & "varfile (>"//TRIM(fct_str(ip_nmaxfiles))//& 290 & "). check namelist.") 291 ENDIF 292 cl_tabfile(jf)=TRIM(cl_file) 293 jv(jf)=jv(jf)+1 294 cl_tabvar(jf,jv(jf))=TRIM(cl_name) 295 ENDIF 296 ENDIF 297 298 ji=ji+1 299 ENDDO 300 301 !print *,'============' 302 !print *,jf,' files ','============' 303 !DO ji=1,jf 304 ! print *,'file ',trim(cl_tabfile(ji)) 305 ! print *,jv(ji),' vars ' 306 ! DO jj=1,jv(ji) 307 ! print *,'var ',trim(cl_tabvar(ji,jj)) 308 ! ENDDO 309 !ENDDO 310 !print *,'============' 311 312 313 il_nfiles=jf 314 il_nvar=0 315 DO ji=1,il_nfiles 316 cl_file=TRIM(cl_tabfile(ji)) 317 318 cl_matrix='' 319 IF( fct_is_num(cl_file(1:1)) )THEN 320 cl_matrix=TRIM(cl_file) 321 WRITE(cl_file,'(a,i2.2)')'data-',ji 322 323 DO jj=1,jv(ji) 324 cl_name=TRIM(cl_tabvar(ji,jv(ji))) 325 cl_lower=TRIM(fct_lower(cl_name)) 326 327 tl_var=var_init(TRIM(cl_name)) 328 CALL var_read_matrix(tl_var, cl_matrix) 329 330 IF( jj == 1 )THEN 236 331 ! create mpp structure 237 332 tl_mpp=mpp_init(TRIM(cl_file), tl_var) 333 ENDIF 334 335 ! add variable 336 CALL mpp_add_var(tl_mpp,tl_var) 337 ! number of variable 338 il_nvar=il_nvar+1 339 340 ENDDO 341 342 ELSE 343 CALL multi__get_perio(cl_file, il_perio) 344 345 tl_file=file_init(TRIM(cl_file), id_perio=il_perio) 346 tl_mpp=mpp_init( tl_file, id_perio=il_perio ) 347 ! clean 348 CALL file_clean(tl_file) 349 350 il_nvarin=tl_mpp%t_proc(1)%i_nvar 351 ALLOCATE(tl_varin(il_nvarin)) 352 DO jj=1,il_nvarin 353 tl_varin(jj)=var_copy(tl_mpp%t_proc(1)%t_var(jj)) 354 DO jl=1,ip_maxdim 355 IF( tl_varin(jj)%t_dim(jl)%l_use )THEN 356 tl_varin(jj)%t_dim(jl)=dim_copy(tl_mpp%t_dim(jl)) 357 ENDIF 358 ENDDO 359 ENDDO 360 361 ! clean all varible 362 CALL mpp_del_var(tl_mpp) 363 364 DO jj=1,jv(ji) 365 cl_name=TRIM(cl_tabvar(ji,jj)) 366 cl_lower=TRIM(fct_lower(cl_name)) 367 ! define variable 368 IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN 369 370 ! check if variable is in file 371 il_varid=var_get_index(tl_varin(:),cl_lower) 372 IF( il_varid == 0 )THEN 373 CALL logger_fatal("MULTI INIT: variable "//& 374 & TRIM(cl_name)//" not in file "//& 375 & TRIM(cl_file) ) 376 ENDIF 377 378 ! get (global) variable dimension 379 tl_dim(jp_I)=dim_copy(tl_varin(il_varid)%t_dim(jp_I)) 380 tl_dim(jp_J)=dim_copy(tl_varin(il_varid)%t_dim(jp_J)) 381 tl_dim(jp_K)=dim_copy(tl_varin(il_varid)%t_dim(jp_K)) 382 tl_dim(jp_L)=dim_copy(tl_varin(il_varid)%t_dim(jp_L)) 383 384 cl_varname=tl_varin(il_varid)%c_name 385 dl_fill=tl_varin(il_varid)%d_fill 386 387 tl_var=var_init(TRIM(cl_varname), td_dim=tl_dim(:), & 388 & dd_fill=dl_fill) 238 389 239 390 ! add variable … … 243 394 il_nvar=il_nvar+1 244 395 245 ELSE 246 247 ! 248 tl_mpp=mpp_init( file_init(TRIM(cl_file)) ) 249 ! define variable 250 IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN 251 252 ! check if variable is in file 253 il_varid=var_get_index(tl_mpp%t_proc(1)%t_var(:),cl_lower) 254 IF( il_varid == 0 )THEN 255 CALL logger_fatal("MULTI INIT: variable "//& 256 & TRIM(cl_name)//" not in file "//& 257 & TRIM(cl_file) ) 396 ! clean structure 397 CALL var_clean(tl_var) 398 399 ELSE ! cl_lower == 'all' 400 401 DO jk=il_nvarin,1,-1 402 403 ! check if variable is dimension 404 ll_dim=.FALSE. 405 DO jl=1,ip_maxdim 406 IF( TRIM(tl_mpp%t_proc(1)%t_dim(jl)%c_name) == & 407 & TRIM(tl_varin(jk)%c_name) )THEN 408 ll_dim=.TRUE. 409 CALL logger_trace("MULTI INIT: "//& 410 & TRIM(tl_varin(jk)%c_name)//& 411 & ' is var dimension') 412 EXIT 413 ENDIF 414 ENDDO 415 ! do not use variable dimension 416 IF( ll_dim )THEN 417 tl_var=var_init( TRIM(tl_varin(jk)%c_name) ) 418 ! delete variable 419 CALL mpp_del_var(tl_mpp,tl_var) 420 ! clean structure 421 CALL var_clean(tl_var) 422 ELSE 423 ! add variable 424 CALL mpp_add_var(tl_mpp, tl_varin(jk)) 425 ! number of variable 426 il_nvar=il_nvar+1 258 427 ENDIF 259 428 260 ! get (global) variable dimension 261 tl_dim(jp_I)=dim_copy(tl_mpp%t_dim(jp_I)) 262 tl_dim(jp_J)=dim_copy(tl_mpp%t_dim(jp_J)) 263 tl_dim(jp_K)=dim_copy(tl_mpp%t_proc(1)%t_var(il_varid)%t_dim(jp_K)) 264 tl_dim(jp_L)=dim_copy(tl_mpp%t_proc(1)%t_var(il_varid)%t_dim(jp_L)) 265 266 ! clean all varible 267 CALL mpp_del_var(tl_mpp) 268 269 tl_var=var_init(TRIM(cl_lower), td_dim=tl_dim(:)) 270 271 ! add variable 272 CALL mpp_add_var(tl_mpp,tl_var) 273 274 ! number of variable 275 il_nvar=il_nvar+1 276 277 ! clean structure 278 CALL var_clean(tl_var) 279 280 ELSE ! cl_lower == 'all' 281 282 DO jk=tl_mpp%t_proc(1)%i_nvar,1,-1 283 284 ! check if variable is dimension 285 ll_dim=.FALSE. 286 DO jj=1,ip_maxdim 287 IF( TRIM(tl_mpp%t_proc(1)%t_dim(jj)%c_name) == & 288 & TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name) )THEN 289 ll_dim=.TRUE. 290 CALL logger_trace("MULTI INIT: "//& 291 & TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name)//& 292 & ' is var dimension') 293 EXIT 294 ENDIF 295 ENDDO 296 ! do not use variable dimension 297 IF( ll_dim )THEN 298 tl_var=var_init( & 299 & TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name) ) 300 ! delete variable 301 CALL mpp_del_var(tl_mpp,tl_var) 302 ! clean structure 303 CALL var_clean(tl_var) 304 ELSE 305 ! number of variable 306 il_nvar=il_nvar+1 307 ENDIF 308 309 ENDDO 310 311 ENDIF 429 ENDDO 312 430 313 431 ENDIF 314 315 CALL multi__add_mpp(multi_init, tl_mpp) 316 317 ! update total number of variable 318 multi_init%i_nvar=multi_init%i_nvar+il_nvar 319 320 ! clean 321 CALL mpp_clean(tl_mpp) 322 323 ELSE 324 CALL logger_error("MULTI INIT: file name matching variable "//& 325 & TRIM(cl_name)//" is empty. check namelist.") 326 ENDIF 327 ELSE 328 CALL logger_error("MULTI INIT: variable name "//& 329 & "is empty. check namelist.") 432 ENDDO 433 ! clean structure 434 CALL var_clean(tl_varin) 435 DEALLOCATE(tl_varin) 436 330 437 ENDIF 331 438 332 ji=ji+1 439 CALL multi__add_mpp(tf_multi, tl_mpp) 440 441 ! update total number of variable 442 tf_multi%i_nvar=tf_multi%i_nvar+tl_mpp%t_proc(1)%i_nvar 443 444 ! clean 445 CALL mpp_clean(tl_mpp) 446 333 447 ENDDO 334 448 335 449 END FUNCTION multi_init 450 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 451 SUBROUTINE multi_clean(td_multi) 336 452 !------------------------------------------------------------------- 337 453 !> @brief This subroutine clean multi file strucutre. 338 ! 454 !> 339 455 !> @author J.Paul 340 456 !> @date November, 2013 - Initial Version 341 ! 457 !> @date January, 2019 458 !> - nullify mpp structure in multi file structure 459 !> 342 460 !> @param[in] td_multi multi file structure 343 461 !------------------------------------------------------------------- 344 SUBROUTINE multi_clean(td_multi) 462 345 463 IMPLICIT NONE 346 464 … … 359 477 CALL mpp_clean(td_multi%t_mpp(:)) 360 478 DEALLOCATE(td_multi%t_mpp) 479 NULLIFY(td_multi%t_mpp) 361 480 ENDIF 362 481 … … 365 484 366 485 END SUBROUTINE multi_clean 486 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 487 SUBROUTINE multi_print(td_multi) 367 488 !------------------------------------------------------------------- 368 489 !> @brief This subroutine print some information about mpp strucutre. 369 ! 490 !> 370 491 !> @author J.Paul 371 492 !> @date November, 2013 - Initial Version 372 ! 493 !> @date January, 2019 494 !> - print periodicity 495 !> @date May, 2019 496 !> - specify format output 497 !> 373 498 !> @param[in] td_multi multi file structure 374 499 !------------------------------------------------------------------- 375 SUBROUTINE multi_print(td_multi) 500 376 501 IMPLICIT NONE 377 502 … … 399 524 WRITE(*,'(6x,a)') & 400 525 & TRIM(td_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 526 !WRITE(*,'(6x,a,i0)') 'perio ',td_multi%t_mpp(ji)%t_proc(1)%i_perio 401 527 ENDIF 402 528 ENDDO … … 405 531 406 532 END SUBROUTINE multi_print 533 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 534 SUBROUTINE multi__add_mpp(td_multi, td_mpp) 407 535 !------------------------------------------------------------------- 408 536 !> @brief … … 410 538 !> 411 539 !> @detail 412 ! 540 !> 413 541 !> @author J.Paul 414 542 !> @date November, 2013 - Initial Version 415 543 !> @date October, 2014 416 544 !> - use mpp file structure instead of file 417 ! 545 !> @date January, 2019 546 !> - deallocate mpp structure whatever happens 547 !> 418 548 !> @param[inout] td_multi multi mpp file strcuture 419 549 !> @param[in] td_mpp mpp file strcuture 420 550 !> @return mpp file id in multi mpp file structure 421 551 !------------------------------------------------------------------- 422 SUBROUTINE multi__add_mpp( td_multi, td_mpp )552 423 553 IMPLICIT NONE 554 424 555 ! Argument 425 556 TYPE(TMULTI), INTENT(INOUT) :: td_multi … … 484 615 ! clean 485 616 CALL mpp_clean(tl_mpp(:)) 486 DEALLOCATE(tl_mpp)487 617 ENDIF 618 DEALLOCATE(tl_mpp) 488 619 489 620 ELSE … … 509 640 510 641 ENDIF 642 511 643 END SUBROUTINE multi__add_mpp 644 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 645 SUBROUTINE multi__get_perio(cd_file, id_perio) 646 !------------------------------------------------------------------- 647 !> @brief 648 !> This subroutine check if variable file, read in namelist, contains 649 !> periodicity value and return it if true. 650 !> 651 !> @details 652 !> periodicity value is assume to follow string "perio =" 653 !> 654 !> @author J.Paul 655 !> @date January, 2019 - Initial Version 656 !> @date August, 209 657 !> - rewrite function to subroutine 658 !> - output filename string contains only filename (no more periodicity if 659 !> given) 660 !> 661 !> @param[inout] cd_file file name 662 !> @param[ out] id_perio NEMO periodicity 663 !------------------------------------------------------------------- 664 665 IMPLICIT NONE 666 667 ! Argument 668 CHARACTER(LEN=*), INTENT(INOUT) :: cd_file 669 INTEGER(i4) , INTENT( OUT) :: id_perio 670 671 ! local variable 672 CHARACTER(LEN=lc) :: cl_tmp 673 CHARACTER(LEN=lc) :: cl_perio 674 675 INTEGER(i4) :: il_ind 676 677 ! loop indices 678 INTEGER(i4) :: ji 679 INTEGER(i4) :: jj 680 !---------------------------------------------------------------- 681 682 ! init 683 cl_perio='' 684 id_perio=-1 685 686 ji=1 687 cl_tmp=fct_split(cd_file,ji,';') 688 DO WHILE( TRIM(cl_tmp) /= '' ) 689 il_ind=INDEX(TRIM(cl_tmp),'perio') 690 IF( il_ind /= 0 )THEN 691 ! check character just after 692 jj=il_ind+LEN('perio') 693 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 694 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 695 cl_perio=fct_split(cl_tmp,2,'=') 696 EXIT 697 ENDIF 698 ENDIF 699 ji=ji+1 700 cl_tmp=fct_split(cd_file,ji,';') 701 ENDDO 702 cd_file=fct_split(cd_file,1,';') 703 704 IF( TRIM(cl_perio) /= '' )THEN 705 IF( fct_is_num(cl_perio) )THEN 706 READ(cl_perio,*) id_perio 707 CALL logger_debug("MULTI GET PERIO: will use periodicity value of "//& 708 & TRIM(fct_str(id_perio))//" for file "//TRIM(cd_file) ) 709 ELSE 710 CALL logger_error("MULTI GET PERIO: invalid periodicity value ("//& 711 & TRIM(cl_perio)//") for file "//TRIM(cd_file)//& 712 & ". check namelist." ) 713 ENDIF 714 ENDIF 715 716 END SUBROUTINE multi__get_perio 717 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 512 718 END MODULE multi 513 719
Note: See TracChangeset
for help on using the changeset viewer.
