Changeset 257
- Timestamp:
- 02/21/08 11:44:35 (17 years ago)
- Location:
- IOIPSL/trunk/tools
- Files:
-
- 2 edited
-
flio_rbld.f90 (modified) (29 diffs)
-
rebuild (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
IOIPSL/trunk/tools/flio_rbld.f90
r148 r257 14 14 !! 15 15 !! rebuild -h 16 !! 16 !! 17 17 !! rebuild [-v] -o outfile infile[1] ... infile[n] 18 18 !! … … 20 20 !! 21 21 !! -h : help 22 !! -v : verbose writing mode22 !! -v lev : verbosity level 23 23 !! -f : force executing mode 24 24 !! -o outfile : name of the recombined file. … … 27 27 !! INPUT for "flio_rbld" : 28 28 !! 29 !! ( C) c_wmode : writing mode (silencious/verbose)29 !! (I) i_v_lev : verbosity level 30 30 !! (C) c_force : executing mode (noforce/force) 31 31 !! (I) f_nb : total number of files 32 32 !! (C) f_nm(:) : names of the files (input_files output_file) 33 !! 33 !! 34 34 !! 35 35 !! ASSOCIATED MODULES : … … 78 78 ! DO loops and test related variables 79 79 INTEGER :: i,ia,id,iv,iw,i_i,i_n 80 LOGICAL :: l_verbose,l_force 80 INTEGER :: ik,itmin,itmax,it1,it2,it 81 LOGICAL :: l_force,l_uld 81 82 !- 82 83 ! Input arguments related variables 83 CHARACTER(LEN=15) :: c_wmode,c_force 84 INTEGER :: f_nb 84 INTEGER :: i_v_lev 85 CHARACTER(LEN=15) :: c_force 86 INTEGER :: f_nb,f_nb_in 85 87 CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: f_nm 86 88 !- … … 96 98 INTEGER,DIMENSION(:),ALLOCATABLE :: f_a_id 97 99 INTEGER :: f_id_i1,f_id_i,f_id_o 98 INTEGER :: f_d_nb,f_v_nb,f_a_nb,f_ ul_d99 INTEGER :: v_ type,v_d_nb,v_a_nb100 INTEGER :: f_d_nb,f_v_nb,f_a_nb,f_d_ul 101 INTEGER :: v_a_nb,a_type 100 102 CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: & 101 103 & f_d_nm,f_v_nm,f_a_nm,v_a_nm 102 104 CHARACTER(LEN=chlen) :: f_u_nm 105 INTEGER,DIMENSION(:),ALLOCATABLE :: v_d_nb,v_d_ul,v_type 106 INTEGER,DIMENSION(:,:),ALLOCATABLE :: v_d_i 103 107 INTEGER,DIMENSION(:),ALLOCATABLE :: f_d_i,f_d_l 104 108 INTEGER :: a_l 105 INTEGER,DIMENSION(flio_max_var_dims) :: v_d_i,ib,ie109 INTEGER,DIMENSION(flio_max_var_dims) :: d_i,ib,ie 106 110 INTEGER,DIMENSION(:),ALLOCATABLE :: & 107 & io_i,io_n, 111 & io_i,io_n,ia_sf,io_sf,io_cf,ia_sm,io_sm,io_cm,ia_sl,io_sl,io_cl 108 112 LOGICAL :: l_ex 109 113 CHARACTER(LEN=chlen) :: c_wn1,c_wn2 … … 150 154 !------------------- 151 155 !- 152 ! Retrieve the write mode 153 READ (UNIT=*,FMT='(A)') c_wmode 154 l_verbose = (TRIM(c_wmode) == 'verbose') 156 ! Retrieve the verbosity level 157 READ (UNIT=*,FMT=*) i_v_lev 155 158 !- 156 159 ! Retrieve the executing mode … … 160 163 ! Retrieve the number of arguments 161 164 READ (UNIT=*,FMT=*) f_nb 165 f_nb_in = f_nb-1 162 166 !- 163 167 ! Retrieve the file names … … 167 171 ENDDO 168 172 !- 169 IF (l_verbose) THEN 173 ! Allocate and initialize the array of file access identifiers 174 ALLOCATE(f_a_id(f_nb_in)); f_a_id(:) = -1; 175 !- 176 IF (i_v_lev >= 1) THEN 170 177 WRITE (UNIT=*,FMT='("")') 171 WRITE (UNIT=*,FMT='(" write mode : """,A,"""")') TRIM(c_wmode)172 WRITE (UNIT=*,FMT='(" exec mode : """,A,"""")') TRIM(c_force)173 WRITE (UNIT=*,FMT='(" n b_args: ",I4)') f_nb178 WRITE (UNIT=*,FMT='(" verbosity level : ",I4)') i_v_lev 179 WRITE (UNIT=*,FMT='(" executing mode : ",A)') TRIM(c_force) 180 WRITE (UNIT=*,FMT='(" number of args : ",I4)') f_nb 174 181 WRITE (UNIT=*,FMT='(" Input files :")') 175 DO iw=1,f_nb -1182 DO iw=1,f_nb_in 176 183 WRITE (*,'(" ",A)') TRIM(f_nm(iw)) 177 184 ENDDO 178 185 WRITE (UNIT=*,FMT='(" Output file :")') 179 186 WRITE (*,'(" ",A)') TRIM(f_nm(f_nb)) 180 ENDIF181 !-182 IF (l_verbose) THEN183 187 !-- time initializations 184 188 CALL system_clock & … … 192 196 !- 193 197 ! Open the first file 194 CALL fl ioopfd (TRIM(f_nm(1)),f_id_i)198 CALL flrb_of (1,f_id_i) 195 199 !- 196 200 ! Get the attribute "DOMAIN_number_total" … … 200 204 ! should be equal to the total number 201 205 ! of domains used in the simulation 202 IF (d_n_t /= (f_nb-1)) THEN206 IF (d_n_t /= f_nb_in) THEN 203 207 IF (l_force) THEN 204 208 iw = 2 205 209 ELSE 206 210 iw = 3 207 DEALLOCATE(f_nm )208 CALL fl ioclo (f_id_i)211 DEALLOCATE(f_nm,f_a_id) 212 CALL flrb_cf (1,.TRUE.) 209 213 ENDIF 210 214 CALL ipslerr (iw,"flio_rbld", & … … 215 219 ! Retrieve the basic characteristics of the first input file 216 220 CALL flioinqf & 217 & (f_id_i,nb_dim=f_d_nb,nb_var=f_v_nb,nb_gat=f_a_nb,id_uld=f_ ul_d)221 & (f_id_i,nb_dim=f_d_nb,nb_var=f_v_nb,nb_gat=f_a_nb,id_uld=f_d_ul) 218 222 !- 219 223 ! Build the list of the names of the … … 229 233 !- 230 234 ! Close the file 231 CALL flioclo (f_id_i) 232 !- 233 !---------------------------------------------------- 234 ! Retrieve domain informations for each input file 235 !---------------------------------------------------- 235 CALL flrb_cf (1,.FALSE.) 236 236 !- 237 237 ! Check if the number of needed files is greater than … … 240 240 ! otherwise keep the "flio" identifiers of the opened files. 241 241 l_ocf = (f_nb > flio_max_files) 242 IF (.NOT.l_ocf) THEN 243 ALLOCATE(f_a_id(f_nb-1)) 244 ENDIF 245 !- 246 DO iw=1,f_nb-1 242 !- 243 !---------------------------------------------------- 244 ! Retrieve domain informations for each input file 245 !---------------------------------------------------- 246 !- 247 DO iw=1,f_nb_in 247 248 !--- 248 CALL flioopfd (TRIM(f_nm(iw)),f_id_i) 249 IF (.NOT.l_ocf) THEN 250 f_a_id(iw) = f_id_i 251 ENDIF 249 CALL flrb_of (iw,f_id_i) 252 250 !--- 253 251 IF (iw > 1) THEN … … 275 273 CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att) 276 274 IF (iw == 1) THEN 275 IF (ANY(dom_att(:) == f_d_ul)) THEN 276 CALL ipslerr (3,"flio_rbld", & 277 & "File : "//TRIM(f_nm(iw)), & 278 & "Attribute : "//TRIM(c_wn1), & 279 & "contains the unlimited dimension") 280 ENDIF 277 281 ALLOCATE (d_d_i(a_l)) 278 282 d_d_i(:) = dom_att(:) … … 335 339 CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att) 336 340 IF (iw == 1) THEN 337 ALLOCATE (d_s_l(a_l,f_nb -1))341 ALLOCATE (d_s_l(a_l,f_nb_in)) 338 342 ENDIF 339 343 d_s_l(:,iw)=dom_att(:) … … 358 362 CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att) 359 363 IF (iw == 1) THEN 360 ALLOCATE (d_p_f(a_l,f_nb -1))364 ALLOCATE (d_p_f(a_l,f_nb_in)) 361 365 ENDIF 362 366 d_p_f(:,iw)=dom_att(:) … … 381 385 CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att) 382 386 IF (iw == 1) THEN 383 ALLOCATE (d_p_l(a_l,f_nb -1))387 ALLOCATE (d_p_l(a_l,f_nb_in)) 384 388 ENDIF 385 389 d_p_l(:,iw)=dom_att(:) … … 404 408 CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att) 405 409 IF (iw == 1) THEN 406 ALLOCATE (d_h_s(a_l,f_nb -1))410 ALLOCATE (d_h_s(a_l,f_nb_in)) 407 411 ENDIF 408 412 d_h_s(:,iw)=dom_att(:) … … 427 431 CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att) 428 432 IF (iw == 1) THEN 429 ALLOCATE (d_h_e(a_l,f_nb -1))433 ALLOCATE (d_h_e(a_l,f_nb_in)) 430 434 ENDIF 431 435 d_h_e(:,iw)=dom_att(:) … … 466 470 ENDIF 467 471 !--- 468 IF (l_ocf) THEN 469 CALL flioclo (f_id_i) 470 ENDIF 472 CALL flrb_cf (iw,l_ocf) 473 !--- 471 474 ENDDO 472 475 !- 473 IF ( l_verbose) THEN476 IF (i_v_lev >= 2) THEN 474 477 WRITE (UNIT=*,FMT='("")') 475 478 WRITE (*,'(" From the first file : ")') … … 481 484 WRITE (*,'(" """,A,"""")') TRIM(f_d_nm(i)) 482 485 ENDDO 483 IF (f_ ul_d> 0) THEN484 WRITE (*,'(" Unlimited dimension id : ",I2)') f_d_i(f_ ul_d)486 IF (f_d_ul > 0) THEN 487 WRITE (*,'(" Unlimited dimension id : ",I2)') f_d_i(f_d_ul) 485 488 ENDIF 486 489 WRITE (*,'(" Number of variables : ",I2)') f_v_nb … … 494 497 WRITE (*,'(" """,A,"""")') TRIM(f_a_nm(i)) 495 498 ENDDO 499 ENDIF 500 IF (i_v_lev >= 3) THEN 496 501 WRITE (UNIT=*,FMT='("")') 497 502 WRITE (*,'(" From input files : ")') … … 500 505 WRITE (*,'(" DOMAIN_size_global :",(10(1X,I5),:))') d_s_g(:) 501 506 WRITE (*,'(" DOMAIN_type : """,(A),"""")') TRIM(c_d_n) 502 DO iw=1,f_nb -1507 DO iw=1,f_nb_in 503 508 WRITE (*,'(" File : ",A)') TRIM(f_nm(iw)) 504 509 WRITE (*,'(" d_s_l :",(10(1X,I5),:))') d_s_l(:,iw) … … 537 542 ENDDO 538 543 !- 539 IF (f_ ul_d> 0) THEN540 i = f_d_l(f_ ul_d); f_d_l(f_ul_d) = -1;544 IF (f_d_ul > 0) THEN 545 i = f_d_l(f_d_ul); f_d_l(f_d_ul) = -1; 541 546 ENDIF 542 547 !- … … 544 549 CALL fliocrfd (TRIM(f_nm(f_nb)),f_d_nm,f_d_l,f_id_o,c_f_n=c_wn1) 545 550 !- 546 IF (l_verbose) THEN 547 WRITE (UNIT=*,FMT='("")') 548 WRITE (UNIT=*,FMT=*) "Output file : ",TRIM(c_wn1) 551 IF (f_d_ul > 0) THEN 552 f_d_l(f_d_ul) = i; itmin = 1; itmax = f_d_l(f_d_ul); 553 ELSE 554 itmin = 1; itmax = 1; 549 555 ENDIF 550 556 !- 551 IF (f_ul_d > 0) THEN552 f_d_l(f_ul_d) = i553 ENDIF554 !-555 557 ! open the first input file used to build the output file 556 558 !- 557 IF (l_ocf) THEN 558 CALL flioopfd (TRIM(f_nm(1)),f_id_i1) 559 ELSE 560 f_id_i1 = f_a_id(1) 561 ENDIF 559 CALL flrb_of (1,f_id_i1) 562 560 !- 563 561 ! define the global attributes in the output file … … 576 574 ! define the variables in the output file 577 575 !- 576 ALLOCATE(v_d_nb(f_v_nb)); v_d_nb(:) = 0; 577 ALLOCATE(v_d_ul(f_v_nb)); v_d_ul(:) = 0; 578 ALLOCATE(v_type(f_v_nb),v_d_i(flio_max_var_dims,f_v_nb)); 578 579 DO iv=1,f_v_nb 579 580 !-- get variable informations 580 581 CALL flioinqv & 581 & (f_id_i1,TRIM(f_v_nm(iv)),l_ex,v_t=v_type , &582 & nb_dims=v_d_nb ,id_dims=v_d_i,nb_atts=v_a_nb)582 & (f_id_i1,TRIM(f_v_nm(iv)),l_ex,v_t=v_type(iv), & 583 & nb_dims=v_d_nb(iv),id_dims=d_i,nb_atts=v_a_nb) 583 584 !-- define the new variable 584 IF (v_d_nb == 0) THEN585 IF (v_d_nb(iv) == 0) THEN 585 586 CALL fliodefv & 586 & (f_id_o,TRIM(f_v_nm(iv)),v_t=v_type )587 & (f_id_o,TRIM(f_v_nm(iv)),v_t=v_type(iv)) 587 588 ELSE 588 589 CALL fliodefv & 589 & (f_id_o,TRIM(f_v_nm(iv)),v_d_i(1:v_d_nb),v_t=v_type) 590 & (f_id_o,TRIM(f_v_nm(iv)),d_i(1:v_d_nb(iv)),v_t=v_type(iv)) 591 DO iw=1,v_d_nb(iv) 592 IF (f_d_ul > 0) THEN 593 IF (d_i(iw) == f_d_ul) THEN 594 v_d_ul(iv) = iw 595 ENDIF 596 ENDIF 597 ENDDO 598 v_d_i(1:v_d_nb(iv),iv) = d_i(1:v_d_nb(iv)) 590 599 ENDIF 591 600 !-- copy all variable attributes … … 600 609 ENDDO 601 610 !- 611 ! update valid_min valid_max attributes values 612 !- 613 CALL flrb_rg 614 !- 602 615 !------------------------ 603 616 ! Fill the output file 604 617 !------------------------ 605 618 !- 606 DO iv=1,f_v_nb 607 !-- get variable informations 608 CALL flioinqv & 609 & (f_id_i1,TRIM(f_v_nm(iv)),l_ex,v_t=v_type, & 610 & nb_dims=v_d_nb,id_dims=v_d_i) 611 IF (l_verbose) THEN 612 WRITE (UNIT=*,FMT='("")') 613 WRITE (UNIT=*,FMT=*) "variable : ",TRIM(f_v_nm(iv)) 619 DO ik=1,2 620 l_uld = (ik /= 1) 621 IF (l_uld) THEN 622 it1=itmin; it2=itmax; 623 ELSE 624 it1=1; it2=1; 614 625 ENDIF 615 !-- do the variable contains dimensions to be recombined ? 616 l_cgd = .FALSE. 617 i_n = 1 618 DO i=1,SIZE(d_d_i) 619 l_cgd = ANY(v_d_i(1:v_d_nb) == d_d_i(i)) 620 l_cgd = l_cgd.AND.ANY(d_s_l(i,1:f_nb-1) /= d_s_g(i)) 621 IF (l_cgd) THEN 622 i_n = f_nb-1 623 EXIT 624 ENDIF 625 ENDDO 626 IF (v_d_nb > 0) THEN 627 !---- Allocate io_i,io_n,ia_sm,io_sm,io_cm 628 ALLOCATE(io_i(v_d_nb),io_n(v_d_nb)) 629 ALLOCATE(ia_sm(v_d_nb),io_sm(v_d_nb),io_cm(v_d_nb)) 630 !---- Default definition of io_i,io_n,io_sm,io_cm 631 io_i(:) = 1; io_n(:) = f_d_l(v_d_i(1:v_d_nb)); 632 ia_sm(:) = 1; io_sm(:) = 1; io_cm(:) = io_n(:); 633 !---- If needed, allocate offset 634 l_o_f = .FALSE.; l_o_l = .FALSE.; 635 IF (TRIM(c_d_n) == "apple") THEN 636 ALLOCATE(ia_sf(v_d_nb),io_sf(v_d_nb),io_cf(v_d_nb)) 637 ALLOCATE(ia_sl(v_d_nb),io_sl(v_d_nb),io_cl(v_d_nb)) 638 ia_sf(:) = 1; io_sf(:) = 1; io_cf(:) = io_n(:); 639 ia_sl(:) = 1; io_sl(:) = 1; io_cl(:) = io_n(:); 640 ENDIF 641 ENDIF 642 !-- 643 DO i_i=1,i_n 644 IF (l_cgd) THEN 645 !------ the variable contains dimensions to be recombined 646 !------- 647 !------ open each file containing a small piece of data 648 IF (l_ocf) THEN 649 IF (i_i == 1) THEN 650 f_id_i = f_id_i1 651 ELSE 652 CALL flioopfd (TRIM(f_nm(i_i)),f_id_i) 626 DO it=it1,it2 627 DO iv=1,f_v_nb 628 IF ( (.NOT.l_uld.AND.(v_d_ul(iv) > 0)) & 629 & .OR.(l_uld.AND.(v_d_ul(iv) <= 0)) ) THEN 630 CYCLE 631 ENDIF 632 IF (i_v_lev >= 3) THEN 633 WRITE (UNIT=*,FMT='("")') 634 IF (l_uld) THEN 635 WRITE (UNIT=*,FMT=*) "time step : ",it 653 636 ENDIF 654 ELSE 655 f_id_i = f_a_id(i_i) 656 ENDIF 657 !------- 658 !------ do the variable has offset at first/last block ? 659 l_cof = .FALSE.; l_col = .FALSE.; 660 IF (TRIM(c_d_n) == "apple") THEN 661 L_BF: DO id=1,v_d_nb 662 DO i=1,SIZE(d_d_i) 663 IF (v_d_i(id) == d_d_i(i)) THEN 664 l_cof = (d_h_s(i,i_i) /= 0) 665 IF (l_cof) EXIT L_BF 666 ENDIF 667 ENDDO 668 ENDDO L_BF 669 L_BL: DO id=1,v_d_nb 670 DO i=1,SIZE(d_d_i) 671 IF (v_d_i(id) == d_d_i(i)) THEN 672 l_col = (d_h_e(i,i_i) /= 0) 673 IF (l_col) EXIT L_BL 674 ENDIF 675 ENDDO 676 ENDDO L_BL 677 ENDIF 678 !------ if needed, redefine start and count for dimensions 679 l_o_f = .FALSE.; l_o_l = .FALSE.; 680 DO id=1,v_d_nb 681 DO i=1,SIZE(d_d_i) 682 IF (v_d_i(id) == d_d_i(i)) THEN 683 io_n(id) = d_p_l(i,i_i)-d_p_f(i,i_i)+1 684 ia_sm(id) = 1 685 io_sm(id) = d_p_f(i,i_i) 686 io_cm(id) = io_n(id) 687 IF (TRIM(c_d_n) == "box") THEN 688 ia_sm(id) = ia_sm(id)+d_h_s(i,i_i) 689 io_sm(id) = io_sm(id)+d_h_s(i,i_i) 690 io_cm(id) = io_cm(id)-d_h_s(i,i_i)-d_h_e(i,i_i) 691 ELSEIF (TRIM(c_d_n) == "apple") THEN 692 IF (l_cof) THEN 693 IF (d_h_s(i,i_i) /= 0) THEN 694 ia_sf(id) = 1+d_h_s(i,i_i) 695 io_sf(id) = d_p_f(i,i_i)+d_h_s(i,i_i) 696 io_cf(id) = io_n(id)-d_h_s(i,i_i) 697 ELSE 698 io_sf(id) = d_p_f(i,i_i) 699 io_cf(id) = 1 700 ia_sm(id) = ia_sm(id)+1 701 io_sm(id) = io_sm(id)+1 702 io_cm(id) = io_cm(id)-1 703 l_o_f = .TRUE. 637 WRITE (UNIT=*,FMT=*) "variable : ",TRIM(f_v_nm(iv)) 638 WRITE (UNIT=*,FMT=*) "var unlim dim : ",v_d_ul(iv) 639 ENDIF 640 !------ do the variable contains dimensions to be recombined ? 641 l_cgd = .FALSE. 642 i_n = 1 643 DO i=1,SIZE(d_d_i) 644 l_cgd = ANY(v_d_i(1:v_d_nb(iv),iv) == d_d_i(i)) 645 l_cgd = l_cgd.AND.ANY(d_s_l(i,1:f_nb_in) /= d_s_g(i)) 646 IF (l_cgd) THEN 647 i_n = f_nb_in 648 EXIT 649 ENDIF 650 ENDDO 651 IF (v_d_nb(iv) > 0) THEN 652 !-------- Allocate io_i,io_n,ia_sm,io_sm,io_cm 653 i = v_d_nb(iv) 654 ALLOCATE(io_i(i),io_n(i),ia_sm(i),io_sm(i),io_cm(i)) 655 !-------- Default definition of io_i,io_n,io_sm,io_cm 656 io_i(:) = 1; io_n(:) = f_d_l(v_d_i(1:v_d_nb(iv),iv)); 657 ia_sm(:) = 1; io_sm(:) = 1; 658 IF (v_d_ul(iv) > 0) THEN 659 io_i(v_d_ul(iv))=it 660 io_n(v_d_ul(iv))=1 661 io_sm(v_d_ul(iv))=it 662 ENDIF 663 io_cm(:) = io_n(:); 664 !-------- If needed, allocate offset 665 l_o_f = .FALSE.; l_o_l = .FALSE.; 666 IF (TRIM(c_d_n) == "apple") THEN 667 ALLOCATE(ia_sf(i),io_sf(i),io_cf(i)) 668 ALLOCATE(ia_sl(i),io_sl(i),io_cl(i)) 669 ia_sf(:) = 1; io_sf(:) = 1; io_cf(:) = io_n(:); 670 ia_sl(:) = 1; io_sl(:) = 1; io_cl(:) = io_n(:); 671 IF (v_d_ul(iv) > 0) THEN 672 io_sf(v_d_ul(iv))=it 673 io_sl(v_d_ul(iv))=it 674 ENDIF 675 ENDIF 676 ENDIF 677 !------ 678 DO i_i=1,i_n 679 IF (l_cgd) THEN 680 !---------- the variable contains dimensions to be recombined 681 !----------- 682 !---------- open each file containing a small piece of data 683 CALL flrb_of (i_i,f_id_i) 684 !----------- 685 !---------- do the variable has offset at first/last block ? 686 l_cof = .FALSE.; l_col = .FALSE.; 687 IF (TRIM(c_d_n) == "apple") THEN 688 L_BF: DO id=1,v_d_nb(iv) 689 DO i=1,SIZE(d_d_i) 690 IF (v_d_i(id,iv) == d_d_i(i)) THEN 691 l_cof = (d_h_s(i,i_i) /= 0) 692 IF (l_cof) EXIT L_BF 693 ENDIF 694 ENDDO 695 ENDDO L_BF 696 L_BL: DO id=1,v_d_nb(iv) 697 DO i=1,SIZE(d_d_i) 698 IF (v_d_i(id,iv) == d_d_i(i)) THEN 699 l_col = (d_h_e(i,i_i) /= 0) 700 IF (l_col) EXIT L_BL 701 ENDIF 702 ENDDO 703 ENDDO L_BL 704 ENDIF 705 !---------- if needed, redefine start and count for dimensions 706 l_o_f = .FALSE.; l_o_l = .FALSE.; 707 DO id=1,v_d_nb(iv) 708 DO i=1,SIZE(d_d_i) 709 IF (v_d_i(id,iv) == d_d_i(i)) THEN 710 io_n(id) = d_p_l(i,i_i)-d_p_f(i,i_i)+1 711 ia_sm(id) = 1 712 io_sm(id) = d_p_f(i,i_i) 713 io_cm(id) = io_n(id) 714 IF (TRIM(c_d_n) == "box") THEN 715 ia_sm(id) = ia_sm(id)+d_h_s(i,i_i) 716 io_sm(id) = io_sm(id)+d_h_s(i,i_i) 717 io_cm(id) = io_cm(id)-d_h_s(i,i_i)-d_h_e(i,i_i) 718 ELSEIF (TRIM(c_d_n) == "apple") THEN 719 IF (l_cof) THEN 720 IF (d_h_s(i,i_i) /= 0) THEN 721 ia_sf(id) = 1+d_h_s(i,i_i) 722 io_sf(id) = d_p_f(i,i_i)+d_h_s(i,i_i) 723 io_cf(id) = io_n(id)-d_h_s(i,i_i) 724 ELSE 725 io_sf(id) = d_p_f(i,i_i) 726 io_cf(id) = 1 727 ia_sm(id) = ia_sm(id)+1 728 io_sm(id) = io_sm(id)+1 729 io_cm(id) = io_cm(id)-1 730 l_o_f = .TRUE. 731 ENDIF 732 ENDIF 733 IF (l_col) THEN 734 IF (d_h_e(i,i_i) /= 0) THEN 735 ia_sl(id) = 1 736 io_sl(id) = d_p_f(i,i_i) 737 io_cl(id) = io_n(id)-d_h_e(i,i_i) 738 ELSE 739 io_cm(id) = io_cm(id)-1 740 ia_sl(id) = 1+io_n(id)-1 741 io_sl(id) = d_p_f(i,i_i)+io_n(id)-1 742 io_cl(id) = 1 743 l_o_l = .TRUE. 744 ENDIF 745 ENDIF 704 746 ENDIF 705 747 ENDIF 706 IF (l_col) THEN 707 IF (d_h_e(i,i_i) /= 0) THEN 708 ia_sl(id) = 1 709 io_sl(id) = d_p_f(i,i_i) 710 io_cl(id) = io_n(id)-d_h_e(i,i_i) 711 ELSE 712 io_cm(id) = io_cm(id)-1 713 ia_sl(id) = 1+io_n(id)-1 714 io_sl(id) = d_p_f(i,i_i)+io_n(id)-1 715 io_cl(id) = 1 716 l_o_l = .TRUE. 717 ENDIF 718 ENDIF 719 ENDIF 748 ENDDO 749 ENDDO 750 ELSE 751 !---------- the data can be read/write in one piece 752 f_id_i = f_id_i1 753 ENDIF 754 !--------- 755 IF (i_v_lev >= 3) THEN 756 WRITE (UNIT=*,FMT=*) & 757 & TRIM(f_nm(i_i))//" - "//TRIM(f_v_nm(iv)) 758 WRITE (UNIT=*,FMT=*) "io_i : ",io_i(:) 759 WRITE (UNIT=*,FMT=*) "io_n : ",io_n(:) 760 WRITE (UNIT=*,FMT=*) "l_o_f : ",l_o_f 761 IF (l_o_f) THEN 762 WRITE (UNIT=*,FMT=*) "ia_sf : ",ia_sf(:) 763 WRITE (UNIT=*,FMT=*) "io_sf : ",io_sf(:) 764 WRITE (UNIT=*,FMT=*) "io_cf : ",io_cf(:) 720 765 ENDIF 721 ENDDO 766 WRITE (UNIT=*,FMT=*) "ia_sm : ",ia_sm(:) 767 WRITE (UNIT=*,FMT=*) "io_sm : ",io_sm(:) 768 WRITE (UNIT=*,FMT=*) "io_cm : ",io_cm(:) 769 WRITE (UNIT=*,FMT=*) "l_o_l : ",l_o_l 770 IF (l_o_l) THEN 771 WRITE (UNIT=*,FMT=*) "ia_sl : ",ia_sl(:) 772 WRITE (UNIT=*,FMT=*) "io_sl : ",io_sl(:) 773 WRITE (UNIT=*,FMT=*) "io_cl : ",io_cl(:) 774 ENDIF 775 ENDIF 776 !--------- 777 !-------- Cases according to the type, shape and offsets of the data 778 !--------- 779 SELECT CASE (v_type(iv)) 780 !?INTEGERS of KIND 1 are not supported on all computers 781 !? CASE (flio_i1) !--- INTEGER 1 782 !? SELECT CASE (v_d_nb(iv)) 783 !? CASE (0) !--- Scalar 784 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_0d) 785 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i1_0d) 786 !? CASE (1) !--- 1d array 787 !? ALLOCATE(i1_1d(io_n(1))) 788 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_1d, & 789 !? & start=io_i(:),count=io_n(:)) 790 !? IF (l_o_f) THEN 791 !? ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1; 792 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 793 !? & i1_1d(ib(1):ie(1)), & 794 !? & start=io_sf(:),count=io_cf(:)) 795 !? ENDIF 796 !? ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1; 797 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 798 !? & i1_1d(ib(1):ie(1)), & 799 !? & start=io_sm(:),count=io_cm(:)) 800 !? IF (l_o_l) THEN 801 !? ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1; 802 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 803 !? & i1_1d(ib(1):ie(1)), & 804 !? & start=io_sl(:),count=io_cl(:)) 805 !? ENDIF 806 !? DEALLOCATE(i1_1d) 807 !? CASE (2) !--- 2d array 808 !? ALLOCATE(i1_2d(io_n(1),io_n(2))) 809 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_2d, & 810 !? & start=io_i(:),count=io_n(:)) 811 !? IF (l_o_f) THEN 812 !? ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1; 813 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 814 !? & i1_2d(ib(1):ie(1),ib(2):ie(2)), & 815 !? & start=io_sf(:),count=io_cf(:)) 816 !? ENDIF 817 !? ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1; 818 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 819 !? & i1_2d(ib(1):ie(1),ib(2):ie(2)), & 820 !? & start=io_sm(:),count=io_cm(:)) 821 !? IF (l_o_l) THEN 822 !? ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1; 823 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 824 !? & i1_2d(ib(1):ie(1),ib(2):ie(2)), & 825 !? & start=io_sl(:),count=io_cl(:)) 826 !? ENDIF 827 !? DEALLOCATE(i1_2d) 828 !? CASE (3) !--- 3d array 829 !? ALLOCATE(i1_3d(io_n(1),io_n(2),io_n(3))) 830 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_3d, & 831 !? & start=io_i(:),count=io_n(:)) 832 !? IF (l_o_f) THEN 833 !? ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1; 834 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 835 !? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 836 !? & start=io_sf(:),count=io_cf(:)) 837 !? ENDIF 838 !? ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1; 839 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 840 !? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 841 !? & start=io_sm(:),count=io_cm(:)) 842 !? IF (l_o_l) THEN 843 !? ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1; 844 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 845 !? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 846 !? & start=io_sl(:),count=io_cl(:)) 847 !? ENDIF 848 !? DEALLOCATE(i1_3d) 849 !? CASE (4) !--- 4d array 850 !? ALLOCATE(i1_4d(io_n(1),io_n(2),io_n(3),io_n(4))) 851 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_4d, & 852 !? & start=io_i(:),count=io_n(:)) 853 !? IF (l_o_f) THEN 854 !? ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1; 855 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 856 !? & i1_4d(ib(1):ie(1),ib(2):ie(2), & 857 !? & ib(3):ie(3),ib(4):ie(4)), & 858 !? & start=io_sf(:),count=io_cf(:)) 859 !? ENDIF 860 !? ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1; 861 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 862 !? & i1_4d(ib(1):ie(1),ib(2):ie(2), & 863 !? & ib(3):ie(3),ib(4):ie(4)), & 864 !? & start=io_sm(:),count=io_cm(:)) 865 !? IF (l_o_l) THEN 866 !? ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1; 867 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 868 !? & i1_4d(ib(1):ie(1),ib(2):ie(2), & 869 !? & ib(3):ie(3),ib(4):ie(4)), & 870 !? & start=io_sl(:),count=io_cl(:)) 871 !? ENDIF 872 !? DEALLOCATE(i1_4d) 873 !? CASE (5) !--- 5d array 874 !? ALLOCATE(i1_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5))) 875 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_5d, & 876 !? & start=io_i(:),count=io_n(:)) 877 !? IF (l_o_f) THEN 878 !? ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1; 879 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 880 !? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 881 !? & ib(4):ie(4),ib(5):ie(5)), & 882 !? & start=io_sf(:),count=io_cf(:)) 883 !? ENDIF 884 !? ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1; 885 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 886 !? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 887 !? & ib(4):ie(4),ib(5):ie(5)), & 888 !? & start=io_sm(:),count=io_cm(:)) 889 !? IF (l_o_l) THEN 890 !? ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1; 891 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 892 !? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 893 !? & ib(4):ie(4),ib(5):ie(5)), & 894 !? & start=io_sl(:),count=io_cl(:)) 895 !? ENDIF 896 !? DEALLOCATE(i1_5d) 897 !? END SELECT 898 !? CASE (flio_i2) !--- INTEGER 2 899 CASE (flio_i1,flio_i2) !--- INTEGER 1/INTEGER 2 900 SELECT CASE (v_d_nb(iv)) 901 CASE (0) !--- Scalar 902 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_0d) 903 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i2_0d) 904 CASE (1) !--- 1d array 905 ALLOCATE(i2_1d(io_n(1))) 906 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_1d, & 907 & start=io_i(:),count=io_n(:)) 908 IF (l_o_f) THEN 909 ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1; 910 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 911 & i2_1d(ib(1):ie(1)), & 912 & start=io_sf(:),count=io_cf(:)) 913 ENDIF 914 ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1; 915 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 916 & i2_1d(ib(1):ie(1)), & 917 & start=io_sm(:),count=io_cm(:)) 918 IF (l_o_l) THEN 919 ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1; 920 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 921 & i2_1d(ib(1):ie(1)), & 922 & start=io_sl(:),count=io_cl(:)) 923 ENDIF 924 DEALLOCATE(i2_1d) 925 CASE (2) !--- 2d array 926 ALLOCATE(i2_2d(io_n(1),io_n(2))) 927 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_2d, & 928 & start=io_i(:),count=io_n(:)) 929 IF (l_o_f) THEN 930 ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1; 931 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 932 & i2_2d(ib(1):ie(1),ib(2):ie(2)), & 933 & start=io_sf(:),count=io_cf(:)) 934 ENDIF 935 ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1; 936 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 937 & i2_2d(ib(1):ie(1),ib(2):ie(2)), & 938 & start=io_sm(:),count=io_cm(:)) 939 IF (l_o_l) THEN 940 ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1; 941 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 942 & i2_2d(ib(1):ie(1),ib(2):ie(2)), & 943 & start=io_sl(:),count=io_cl(:)) 944 ENDIF 945 DEALLOCATE(i2_2d) 946 CASE (3) !--- 3d array 947 ALLOCATE(i2_3d(io_n(1),io_n(2),io_n(3))) 948 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_3d, & 949 & start=io_i(:),count=io_n(:)) 950 IF (l_o_f) THEN 951 ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1; 952 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 953 & i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 954 & start=io_sf(:),count=io_cf(:)) 955 ENDIF 956 ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1; 957 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 958 & i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 959 & start=io_sm(:),count=io_cm(:)) 960 IF (l_o_l) THEN 961 ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1; 962 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 963 & i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 964 & start=io_sl(:),count=io_cl(:)) 965 ENDIF 966 DEALLOCATE(i2_3d) 967 CASE (4) !--- 4d array 968 ALLOCATE(i2_4d(io_n(1),io_n(2),io_n(3),io_n(4))) 969 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_4d, & 970 & start=io_i(:),count=io_n(:)) 971 IF (l_o_f) THEN 972 ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1; 973 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 974 & i2_4d(ib(1):ie(1),ib(2):ie(2), & 975 & ib(3):ie(3),ib(4):ie(4)), & 976 & start=io_sf(:),count=io_cf(:)) 977 ENDIF 978 ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1; 979 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 980 & i2_4d(ib(1):ie(1),ib(2):ie(2), & 981 & ib(3):ie(3),ib(4):ie(4)), & 982 & start=io_sm(:),count=io_cm(:)) 983 IF (l_o_l) THEN 984 ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1; 985 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 986 & i2_4d(ib(1):ie(1),ib(2):ie(2), & 987 & ib(3):ie(3),ib(4):ie(4)), & 988 & start=io_sl(:),count=io_cl(:)) 989 ENDIF 990 DEALLOCATE(i2_4d) 991 CASE (5) !--- 5d array 992 ALLOCATE(i2_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5))) 993 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_5d, & 994 & start=io_i(:),count=io_n(:)) 995 IF (l_o_f) THEN 996 ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1; 997 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 998 & i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 999 & ib(4):ie(4),ib(5):ie(5)), & 1000 & start=io_sf(:),count=io_cf(:)) 1001 ENDIF 1002 ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1; 1003 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1004 & i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1005 & ib(4):ie(4),ib(5):ie(5)), & 1006 & start=io_sm(:),count=io_cm(:)) 1007 IF (l_o_l) THEN 1008 ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1; 1009 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1010 & i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1011 & ib(4):ie(4),ib(5):ie(5)), & 1012 & start=io_sl(:),count=io_cl(:)) 1013 ENDIF 1014 DEALLOCATE(i2_5d) 1015 END SELECT 1016 CASE (flio_i4) !--- INTEGER 4 1017 SELECT CASE (v_d_nb(iv)) 1018 CASE (0) !--- Scalar 1019 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_0d) 1020 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i4_0d) 1021 CASE (1) !--- 1d array 1022 ALLOCATE(i4_1d(io_n(1))) 1023 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_1d, & 1024 & start=io_i(:),count=io_n(:)) 1025 IF (l_o_f) THEN 1026 ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1; 1027 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1028 & i4_1d(ib(1):ie(1)), & 1029 & start=io_sf(:),count=io_cf(:)) 1030 ENDIF 1031 ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1; 1032 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1033 & i4_1d(ib(1):ie(1)), & 1034 & start=io_sm(:),count=io_cm(:)) 1035 IF (l_o_l) THEN 1036 ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1; 1037 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1038 & i4_1d(ib(1):ie(1)), & 1039 & start=io_sl(:),count=io_cl(:)) 1040 ENDIF 1041 DEALLOCATE(i4_1d) 1042 CASE (2) !--- 2d array 1043 ALLOCATE(i4_2d(io_n(1),io_n(2))) 1044 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_2d, & 1045 & start=io_i(:),count=io_n(:)) 1046 IF (l_o_f) THEN 1047 ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1; 1048 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1049 & i4_2d(ib(1):ie(1),ib(2):ie(2)), & 1050 & start=io_sf(:),count=io_cf(:)) 1051 ENDIF 1052 ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1; 1053 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1054 & i4_2d(ib(1):ie(1),ib(2):ie(2)), & 1055 & start=io_sm(:),count=io_cm(:)) 1056 IF (l_o_l) THEN 1057 ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1; 1058 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1059 & i4_2d(ib(1):ie(1),ib(2):ie(2)), & 1060 & start=io_sl(:),count=io_cl(:)) 1061 ENDIF 1062 DEALLOCATE(i4_2d) 1063 CASE (3) !--- 3d array 1064 ALLOCATE(i4_3d(io_n(1),io_n(2),io_n(3))) 1065 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_3d, & 1066 & start=io_i(:),count=io_n(:)) 1067 IF (l_o_f) THEN 1068 ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1; 1069 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1070 & i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1071 & start=io_sf(:),count=io_cf(:)) 1072 ENDIF 1073 ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1; 1074 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1075 & i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1076 & start=io_sm(:),count=io_cm(:)) 1077 IF (l_o_l) THEN 1078 ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1; 1079 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1080 & i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1081 & start=io_sl(:),count=io_cl(:)) 1082 ENDIF 1083 DEALLOCATE(i4_3d) 1084 CASE (4) !--- 4d array 1085 ALLOCATE(i4_4d(io_n(1),io_n(2),io_n(3),io_n(4))) 1086 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_4d, & 1087 & start=io_i(:),count=io_n(:)) 1088 IF (l_o_f) THEN 1089 ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1; 1090 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1091 & i4_4d(ib(1):ie(1),ib(2):ie(2), & 1092 & ib(3):ie(3),ib(4):ie(4)), & 1093 & start=io_sf(:),count=io_cf(:)) 1094 ENDIF 1095 ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1; 1096 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1097 & i4_4d(ib(1):ie(1),ib(2):ie(2), & 1098 & ib(3):ie(3),ib(4):ie(4)), & 1099 & start=io_sm(:),count=io_cm(:)) 1100 IF (l_o_l) THEN 1101 ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1; 1102 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1103 & i4_4d(ib(1):ie(1),ib(2):ie(2), & 1104 & ib(3):ie(3),ib(4):ie(4)), & 1105 & start=io_sl(:),count=io_cl(:)) 1106 ENDIF 1107 DEALLOCATE(i4_4d) 1108 CASE (5) !--- 5d array 1109 ALLOCATE(i4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5))) 1110 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_5d, & 1111 & start=io_i(:),count=io_n(:)) 1112 IF (l_o_f) THEN 1113 ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1; 1114 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1115 & i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1116 & ib(4):ie(4),ib(5):ie(5)), & 1117 & start=io_sf(:),count=io_cf(:)) 1118 ENDIF 1119 ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1; 1120 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1121 & i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1122 & ib(4):ie(4),ib(5):ie(5)), & 1123 & start=io_sm(:),count=io_cm(:)) 1124 IF (l_o_l) THEN 1125 ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1; 1126 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1127 & i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1128 & ib(4):ie(4),ib(5):ie(5)), & 1129 & start=io_sl(:),count=io_cl(:)) 1130 ENDIF 1131 DEALLOCATE(i4_5d) 1132 END SELECT 1133 CASE (flio_r4) !--- REAL 4 1134 SELECT CASE (v_d_nb(iv)) 1135 CASE (0) !--- Scalar 1136 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_0d) 1137 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r4_0d) 1138 CASE (1) !--- 1d array 1139 ALLOCATE(r4_1d(io_n(1))) 1140 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_1d, & 1141 & start=io_i(:),count=io_n(:)) 1142 IF (l_o_f) THEN 1143 ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1; 1144 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1145 & r4_1d(ib(1):ie(1)), & 1146 & start=io_sf(:),count=io_cf(:)) 1147 ENDIF 1148 ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1; 1149 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1150 & r4_1d(ib(1):ie(1)), & 1151 & start=io_sm(:),count=io_cm(:)) 1152 IF (l_o_l) THEN 1153 ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1; 1154 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1155 & r4_1d(ib(1):ie(1)), & 1156 & start=io_sl(:),count=io_cl(:)) 1157 ENDIF 1158 DEALLOCATE(r4_1d) 1159 CASE (2) !--- 2d array 1160 ALLOCATE(r4_2d(io_n(1),io_n(2))) 1161 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_2d, & 1162 & start=io_i(:),count=io_n(:)) 1163 IF (l_o_f) THEN 1164 ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1; 1165 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1166 & r4_2d(ib(1):ie(1),ib(2):ie(2)), & 1167 & start=io_sf(:),count=io_cf(:)) 1168 ENDIF 1169 ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1; 1170 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1171 & r4_2d(ib(1):ie(1),ib(2):ie(2)), & 1172 & start=io_sm(:),count=io_cm(:)) 1173 IF (l_o_l) THEN 1174 ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1; 1175 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1176 & r4_2d(ib(1):ie(1),ib(2):ie(2)), & 1177 & start=io_sl(:),count=io_cl(:)) 1178 ENDIF 1179 DEALLOCATE(r4_2d) 1180 CASE (3) !--- 3d array 1181 ALLOCATE(r4_3d(io_n(1),io_n(2),io_n(3))) 1182 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_3d, & 1183 & start=io_i(:),count=io_n(:)) 1184 IF (l_o_f) THEN 1185 ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1; 1186 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1187 & r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1188 & start=io_sf(:),count=io_cf(:)) 1189 ENDIF 1190 ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1; 1191 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1192 & r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1193 & start=io_sm(:),count=io_cm(:)) 1194 IF (l_o_l) THEN 1195 ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1; 1196 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1197 & r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1198 & start=io_sl(:),count=io_cl(:)) 1199 ENDIF 1200 DEALLOCATE(r4_3d) 1201 CASE (4) !--- 4d array 1202 ALLOCATE(r4_4d(io_n(1),io_n(2),io_n(3),io_n(4))) 1203 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_4d, & 1204 & start=io_i(:),count=io_n(:)) 1205 IF (l_o_f) THEN 1206 ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1; 1207 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1208 & r4_4d(ib(1):ie(1),ib(2):ie(2), & 1209 & ib(3):ie(3),ib(4):ie(4)), & 1210 & start=io_sf(:),count=io_cf(:)) 1211 ENDIF 1212 ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1; 1213 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1214 & r4_4d(ib(1):ie(1),ib(2):ie(2), & 1215 & ib(3):ie(3),ib(4):ie(4)), & 1216 & start=io_sm(:),count=io_cm(:)) 1217 IF (l_o_l) THEN 1218 ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1; 1219 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1220 & r4_4d(ib(1):ie(1),ib(2):ie(2), & 1221 & ib(3):ie(3),ib(4):ie(4)), & 1222 & start=io_sl(:),count=io_cl(:)) 1223 ENDIF 1224 DEALLOCATE(r4_4d) 1225 CASE (5) !--- 5d array 1226 ALLOCATE(r4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5))) 1227 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_5d, & 1228 & start=io_i(:),count=io_n(:)) 1229 IF (l_o_f) THEN 1230 ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1; 1231 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1232 & r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1233 & ib(4):ie(4),ib(5):ie(5)), & 1234 & start=io_sf(:),count=io_cf(:)) 1235 ENDIF 1236 ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1; 1237 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1238 & r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1239 & ib(4):ie(4),ib(5):ie(5)), & 1240 & start=io_sm(:),count=io_cm(:)) 1241 IF (l_o_l) THEN 1242 ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1; 1243 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1244 & r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1245 & ib(4):ie(4),ib(5):ie(5)), & 1246 & start=io_sl(:),count=io_cl(:)) 1247 ENDIF 1248 DEALLOCATE(r4_5d) 1249 END SELECT 1250 CASE (flio_r8) !--- REAL 8 1251 SELECT CASE (v_d_nb(iv)) 1252 CASE (0) !--- Scalar 1253 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_0d) 1254 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r8_0d) 1255 CASE (1) !--- 1d array 1256 ALLOCATE(r8_1d(io_n(1))) 1257 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_1d, & 1258 & start=io_i(:),count=io_n(:)) 1259 IF (l_o_f) THEN 1260 ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1; 1261 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1262 & r8_1d(ib(1):ie(1)), & 1263 & start=io_sf(:),count=io_cf(:)) 1264 ENDIF 1265 ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1; 1266 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1267 & r8_1d(ib(1):ie(1)), & 1268 & start=io_sm(:),count=io_cm(:)) 1269 IF (l_o_l) THEN 1270 ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1; 1271 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1272 & r8_1d(ib(1):ie(1)), & 1273 & start=io_sl(:),count=io_cl(:)) 1274 ENDIF 1275 DEALLOCATE(r8_1d) 1276 CASE (2) !--- 2d array 1277 ALLOCATE(r8_2d(io_n(1),io_n(2))) 1278 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_2d, & 1279 & start=io_i(:),count=io_n(:)) 1280 IF (l_o_f) THEN 1281 ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1; 1282 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1283 & r8_2d(ib(1):ie(1),ib(2):ie(2)), & 1284 & start=io_sf(:),count=io_cf(:)) 1285 ENDIF 1286 ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1; 1287 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1288 & r8_2d(ib(1):ie(1),ib(2):ie(2)), & 1289 & start=io_sm(:),count=io_cm(:)) 1290 IF (l_o_l) THEN 1291 ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1; 1292 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1293 & r8_2d(ib(1):ie(1),ib(2):ie(2)), & 1294 & start=io_sl(:),count=io_cl(:)) 1295 ENDIF 1296 DEALLOCATE(r8_2d) 1297 CASE (3) !--- 3d array 1298 ALLOCATE(r8_3d(io_n(1),io_n(2),io_n(3))) 1299 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_3d, & 1300 & start=io_i(:),count=io_n(:)) 1301 IF (l_o_f) THEN 1302 ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1; 1303 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1304 & r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1305 & start=io_sf(:),count=io_cf(:)) 1306 ENDIF 1307 ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1; 1308 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1309 & r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1310 & start=io_sm(:),count=io_cm(:)) 1311 IF (l_o_l) THEN 1312 ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1; 1313 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1314 & r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1315 & start=io_sl(:),count=io_cl(:)) 1316 ENDIF 1317 DEALLOCATE(r8_3d) 1318 CASE (4) !--- 4d array 1319 ALLOCATE(r8_4d(io_n(1),io_n(2),io_n(3),io_n(4))) 1320 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_4d, & 1321 & start=io_i(:),count=io_n(:)) 1322 IF (l_o_f) THEN 1323 ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1; 1324 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1325 & r8_4d(ib(1):ie(1),ib(2):ie(2), & 1326 & ib(3):ie(3),ib(4):ie(4)), & 1327 & start=io_sf(:),count=io_cf(:)) 1328 ENDIF 1329 ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1; 1330 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1331 & r8_4d(ib(1):ie(1),ib(2):ie(2), & 1332 & ib(3):ie(3),ib(4):ie(4)), & 1333 & start=io_sm(:),count=io_cm(:)) 1334 IF (l_o_l) THEN 1335 ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1; 1336 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1337 & r8_4d(ib(1):ie(1),ib(2):ie(2), & 1338 & ib(3):ie(3),ib(4):ie(4)), & 1339 & start=io_sl(:),count=io_cl(:)) 1340 ENDIF 1341 DEALLOCATE(r8_4d) 1342 CASE (5) !--- 5d array 1343 ALLOCATE(r8_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5))) 1344 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_5d, & 1345 & start=io_i(:),count=io_n(:)) 1346 IF (l_o_f) THEN 1347 ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1; 1348 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1349 & r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1350 & ib(4):ie(4),ib(5):ie(5)), & 1351 & start=io_sf(:),count=io_cf(:)) 1352 ENDIF 1353 ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1; 1354 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1355 & r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1356 & ib(4):ie(4),ib(5):ie(5)), & 1357 & start=io_sm(:),count=io_cm(:)) 1358 IF (l_o_l) THEN 1359 ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1; 1360 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1361 & r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1362 & ib(4):ie(4),ib(5):ie(5)), & 1363 & start=io_sl(:),count=io_cl(:)) 1364 ENDIF 1365 DEALLOCATE(r8_5d) 1366 END SELECT 1367 END SELECT 1368 !-------- eventually close each file containing a small piece of data 1369 CALL flrb_cf (i_i,l_ocf.AND.l_cgd.AND.(i_i /= 1)) 722 1370 ENDDO 723 ELSE 724 !------ the data can be read/write in one piece 725 f_id_i = f_id_i1 726 ENDIF 727 !----- 728 IF (l_verbose) THEN 729 WRITE (UNIT=*,FMT=*) TRIM(f_nm(i_i))//" - "//TRIM(f_v_nm(iv)) 730 WRITE (UNIT=*,FMT=*) "io_i : ",io_i(:) 731 WRITE (UNIT=*,FMT=*) "io_n : ",io_n(:) 732 WRITE (UNIT=*,FMT=*) "l_o_f : ",l_o_f 733 IF (l_o_f) THEN 734 WRITE (UNIT=*,FMT=*) "ia_sf : ",ia_sf(:) 735 WRITE (UNIT=*,FMT=*) "io_sf : ",io_sf(:) 736 WRITE (UNIT=*,FMT=*) "io_cf : ",io_cf(:) 737 ENDIF 738 WRITE (UNIT=*,FMT=*) "ia_sm : ",ia_sm(:) 739 WRITE (UNIT=*,FMT=*) "io_sm : ",io_sm(:) 740 WRITE (UNIT=*,FMT=*) "io_cm : ",io_cm(:) 741 WRITE (UNIT=*,FMT=*) "l_o_l : ",l_o_l 742 IF (l_o_l) THEN 743 WRITE (UNIT=*,FMT=*) "ia_sl : ",ia_sl(:) 744 WRITE (UNIT=*,FMT=*) "io_sl : ",io_sl(:) 745 WRITE (UNIT=*,FMT=*) "io_cl : ",io_cl(:) 746 ENDIF 747 ENDIF 748 !----- 749 !---- Cases according to the type, shape and offsets of the data 750 !----- 751 SELECT CASE (v_type) 752 !?INTEGERS of KIND 1 are not supported on all computers 753 !? CASE (flio_i1) !--- INTEGER 1 754 !? SELECT CASE (v_d_nb) 755 !? CASE (0) !--- Scalar 756 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_0d) 757 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i1_0d) 758 !? CASE (1) !--- 1d array 759 !? ALLOCATE(i1_1d(io_n(1))) 760 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_1d, & 761 !? & start=io_i(:),count=io_n(:)) 762 !? IF (l_o_f) THEN 763 !? ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1; 764 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 765 !? & i1_1d(ib(1):ie(1)), & 766 !? & start=io_sf(:),count=io_cf(:)) 767 !? ENDIF 768 !? ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1; 769 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 770 !? & i1_1d(ib(1):ie(1)), & 771 !? & start=io_sm(:),count=io_cm(:)) 772 !? IF (l_o_l) THEN 773 !? ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1; 774 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 775 !? & i1_1d(ib(1):ie(1)), & 776 !? & start=io_sl(:),count=io_cl(:)) 777 !? ENDIF 778 !? DEALLOCATE(i1_1d) 779 !? CASE (2) !--- 2d array 780 !? ALLOCATE(i1_2d(io_n(1),io_n(2))) 781 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_2d, & 782 !? & start=io_i(:),count=io_n(:)) 783 !? IF (l_o_f) THEN 784 !? ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1; 785 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 786 !? & i1_2d(ib(1):ie(1),ib(2):ie(2)), & 787 !? & start=io_sf(:),count=io_cf(:)) 788 !? ENDIF 789 !? ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1; 790 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 791 !? & i1_2d(ib(1):ie(1),ib(2):ie(2)), & 792 !? & start=io_sm(:),count=io_cm(:)) 793 !? IF (l_o_l) THEN 794 !? ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1; 795 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 796 !? & i1_2d(ib(1):ie(1),ib(2):ie(2)), & 797 !? & start=io_sl(:),count=io_cl(:)) 798 !? ENDIF 799 !? DEALLOCATE(i1_2d) 800 !? CASE (3) !--- 3d array 801 !? ALLOCATE(i1_3d(io_n(1),io_n(2),io_n(3))) 802 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_3d, & 803 !? & start=io_i(:),count=io_n(:)) 804 !? IF (l_o_f) THEN 805 !? ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1; 806 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 807 !? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 808 !? & start=io_sf(:),count=io_cf(:)) 809 !? ENDIF 810 !? ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1; 811 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 812 !? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 813 !? & start=io_sm(:),count=io_cm(:)) 814 !? IF (l_o_l) THEN 815 !? ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1; 816 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 817 !? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 818 !? & start=io_sl(:),count=io_cl(:)) 819 !? ENDIF 820 !? DEALLOCATE(i1_3d) 821 !? CASE (4) !--- 4d array 822 !? ALLOCATE(i1_4d(io_n(1),io_n(2),io_n(3),io_n(4))) 823 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_4d, & 824 !? & start=io_i(:),count=io_n(:)) 825 !? IF (l_o_f) THEN 826 !? ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1; 827 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 828 !? & i1_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 829 !? & start=io_sf(:),count=io_cf(:)) 830 !? ENDIF 831 !? ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1; 832 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 833 !? & i1_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 834 !? & start=io_sm(:),count=io_cm(:)) 835 !? IF (l_o_l) THEN 836 !? ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1; 837 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 838 !? & i1_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 839 !? & start=io_sl(:),count=io_cl(:)) 840 !? ENDIF 841 !? DEALLOCATE(i1_4d) 842 !? CASE (5) !--- 5d array 843 !? ALLOCATE(i1_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5))) 844 !? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_5d, & 845 !? & start=io_i(:),count=io_n(:)) 846 !? IF (l_o_f) THEN 847 !? ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1; 848 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 849 !? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 850 !? & ib(4):ie(4),ib(5):ie(5)), & 851 !? & start=io_sf(:),count=io_cf(:)) 852 !? ENDIF 853 !? ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1; 854 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 855 !? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 856 !? & ib(4):ie(4),ib(5):ie(5)), & 857 !? & start=io_sm(:),count=io_cm(:)) 858 !? IF (l_o_l) THEN 859 !? ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1; 860 !? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 861 !? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 862 !? & ib(4):ie(4),ib(5):ie(5)), & 863 !? & start=io_sl(:),count=io_cl(:)) 864 !? ENDIF 865 !? DEALLOCATE(i1_5d) 866 !? END SELECT 867 !? CASE (flio_i2) !--- INTEGER 2 868 CASE (flio_i1,flio_i2) !--- INTEGER 1/INTEGER 2 869 SELECT CASE (v_d_nb) 870 CASE (0) !--- Scalar 871 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_0d) 872 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i2_0d) 873 CASE (1) !--- 1d array 874 ALLOCATE(i2_1d(io_n(1))) 875 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_1d, & 876 & start=io_i(:),count=io_n(:)) 877 IF (l_o_f) THEN 878 ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1; 879 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 880 & i2_1d(ib(1):ie(1)), & 881 & start=io_sf(:),count=io_cf(:)) 1371 !------ If needed, deallocate io_* arrays 1372 IF (v_d_nb(iv) > 0) THEN 1373 DEALLOCATE(io_i,io_n,ia_sm,io_sm,io_cm) 1374 IF (TRIM(c_d_n) == "apple") THEN 1375 DEALLOCATE(ia_sf,io_sf,io_cf) 1376 DEALLOCATE(ia_sl,io_sl,io_cl) 882 1377 ENDIF 883 ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1; 884 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 885 & i2_1d(ib(1):ie(1)), & 886 & start=io_sm(:),count=io_cm(:)) 887 IF (l_o_l) THEN 888 ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1; 889 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 890 & i2_1d(ib(1):ie(1)), & 891 & start=io_sl(:),count=io_cl(:)) 892 ENDIF 893 DEALLOCATE(i2_1d) 894 CASE (2) !--- 2d array 895 ALLOCATE(i2_2d(io_n(1),io_n(2))) 896 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_2d, & 897 & start=io_i(:),count=io_n(:)) 898 IF (l_o_f) THEN 899 ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1; 900 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 901 & i2_2d(ib(1):ie(1),ib(2):ie(2)), & 902 & start=io_sf(:),count=io_cf(:)) 903 ENDIF 904 ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1; 905 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 906 & i2_2d(ib(1):ie(1),ib(2):ie(2)), & 907 & start=io_sm(:),count=io_cm(:)) 908 IF (l_o_l) THEN 909 ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1; 910 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 911 & i2_2d(ib(1):ie(1),ib(2):ie(2)), & 912 & start=io_sl(:),count=io_cl(:)) 913 ENDIF 914 DEALLOCATE(i2_2d) 915 CASE (3) !--- 3d array 916 ALLOCATE(i2_3d(io_n(1),io_n(2),io_n(3))) 917 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_3d, & 918 & start=io_i(:),count=io_n(:)) 919 IF (l_o_f) THEN 920 ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1; 921 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 922 & i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 923 & start=io_sf(:),count=io_cf(:)) 924 ENDIF 925 ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1; 926 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 927 & i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 928 & start=io_sm(:),count=io_cm(:)) 929 IF (l_o_l) THEN 930 ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1; 931 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 932 & i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 933 & start=io_sl(:),count=io_cl(:)) 934 ENDIF 935 DEALLOCATE(i2_3d) 936 CASE (4) !--- 4d array 937 ALLOCATE(i2_4d(io_n(1),io_n(2),io_n(3),io_n(4))) 938 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_4d, & 939 & start=io_i(:),count=io_n(:)) 940 IF (l_o_f) THEN 941 ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1; 942 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 943 & i2_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 944 & start=io_sf(:),count=io_cf(:)) 945 ENDIF 946 ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1; 947 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 948 & i2_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 949 & start=io_sm(:),count=io_cm(:)) 950 IF (l_o_l) THEN 951 ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1; 952 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 953 & i2_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 954 & start=io_sl(:),count=io_cl(:)) 955 ENDIF 956 DEALLOCATE(i2_4d) 957 CASE (5) !--- 5d array 958 ALLOCATE(i2_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5))) 959 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_5d, & 960 & start=io_i(:),count=io_n(:)) 961 IF (l_o_f) THEN 962 ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1; 963 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 964 & i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 965 & ib(4):ie(4),ib(5):ie(5)), & 966 & start=io_sf(:),count=io_cf(:)) 967 ENDIF 968 ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1; 969 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 970 & i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 971 & ib(4):ie(4),ib(5):ie(5)), & 972 & start=io_sm(:),count=io_cm(:)) 973 IF (l_o_l) THEN 974 ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1; 975 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 976 & i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 977 & ib(4):ie(4),ib(5):ie(5)), & 978 & start=io_sl(:),count=io_cl(:)) 979 ENDIF 980 DEALLOCATE(i2_5d) 981 END SELECT 982 CASE (flio_i4) !--- INTEGER 4 983 SELECT CASE (v_d_nb) 984 CASE (0) !--- Scalar 985 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_0d) 986 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i4_0d) 987 CASE (1) !--- 1d array 988 ALLOCATE(i4_1d(io_n(1))) 989 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_1d, & 990 & start=io_i(:),count=io_n(:)) 991 IF (l_o_f) THEN 992 ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1; 993 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 994 & i4_1d(ib(1):ie(1)), & 995 & start=io_sf(:),count=io_cf(:)) 996 ENDIF 997 ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1; 998 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 999 & i4_1d(ib(1):ie(1)), & 1000 & start=io_sm(:),count=io_cm(:)) 1001 IF (l_o_l) THEN 1002 ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1; 1003 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1004 & i4_1d(ib(1):ie(1)), & 1005 & start=io_sl(:),count=io_cl(:)) 1006 ENDIF 1007 DEALLOCATE(i4_1d) 1008 CASE (2) !--- 2d array 1009 ALLOCATE(i4_2d(io_n(1),io_n(2))) 1010 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_2d, & 1011 & start=io_i(:),count=io_n(:)) 1012 IF (l_o_f) THEN 1013 ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1; 1014 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1015 & i4_2d(ib(1):ie(1),ib(2):ie(2)), & 1016 & start=io_sf(:),count=io_cf(:)) 1017 ENDIF 1018 ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1; 1019 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1020 & i4_2d(ib(1):ie(1),ib(2):ie(2)), & 1021 & start=io_sm(:),count=io_cm(:)) 1022 IF (l_o_l) THEN 1023 ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1; 1024 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1025 & i4_2d(ib(1):ie(1),ib(2):ie(2)), & 1026 & start=io_sl(:),count=io_cl(:)) 1027 ENDIF 1028 DEALLOCATE(i4_2d) 1029 CASE (3) !--- 3d array 1030 ALLOCATE(i4_3d(io_n(1),io_n(2),io_n(3))) 1031 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_3d, & 1032 & start=io_i(:),count=io_n(:)) 1033 IF (l_o_f) THEN 1034 ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1; 1035 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1036 & i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1037 & start=io_sf(:),count=io_cf(:)) 1038 ENDIF 1039 ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1; 1040 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1041 & i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1042 & start=io_sm(:),count=io_cm(:)) 1043 IF (l_o_l) THEN 1044 ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1; 1045 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1046 & i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1047 & start=io_sl(:),count=io_cl(:)) 1048 ENDIF 1049 DEALLOCATE(i4_3d) 1050 CASE (4) !--- 4d array 1051 ALLOCATE(i4_4d(io_n(1),io_n(2),io_n(3),io_n(4))) 1052 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_4d, & 1053 & start=io_i(:),count=io_n(:)) 1054 IF (l_o_f) THEN 1055 ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1; 1056 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1057 & i4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 1058 & start=io_sf(:),count=io_cf(:)) 1059 ENDIF 1060 ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1; 1061 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1062 & i4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 1063 & start=io_sm(:),count=io_cm(:)) 1064 IF (l_o_l) THEN 1065 ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1; 1066 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1067 & i4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 1068 & start=io_sl(:),count=io_cl(:)) 1069 ENDIF 1070 DEALLOCATE(i4_4d) 1071 CASE (5) !--- 5d array 1072 ALLOCATE(i4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5))) 1073 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_5d, & 1074 & start=io_i(:),count=io_n(:)) 1075 IF (l_o_f) THEN 1076 ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1; 1077 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1078 & i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1079 & ib(4):ie(4),ib(5):ie(5)), & 1080 & start=io_sf(:),count=io_cf(:)) 1081 ENDIF 1082 ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1; 1083 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1084 & i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1085 & ib(4):ie(4),ib(5):ie(5)), & 1086 & start=io_sm(:),count=io_cm(:)) 1087 IF (l_o_l) THEN 1088 ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1; 1089 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1090 & i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1091 & ib(4):ie(4),ib(5):ie(5)), & 1092 & start=io_sl(:),count=io_cl(:)) 1093 ENDIF 1094 DEALLOCATE(i4_5d) 1095 END SELECT 1096 CASE (flio_r4) !--- REAL 4 1097 SELECT CASE (v_d_nb) 1098 CASE (0) !--- Scalar 1099 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_0d) 1100 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r4_0d) 1101 CASE (1) !--- 1d array 1102 ALLOCATE(r4_1d(io_n(1))) 1103 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_1d, & 1104 & start=io_i(:),count=io_n(:)) 1105 IF (l_o_f) THEN 1106 ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1; 1107 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1108 & r4_1d(ib(1):ie(1)), & 1109 & start=io_sf(:),count=io_cf(:)) 1110 ENDIF 1111 ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1; 1112 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1113 & r4_1d(ib(1):ie(1)), & 1114 & start=io_sm(:),count=io_cm(:)) 1115 IF (l_o_l) THEN 1116 ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1; 1117 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1118 & r4_1d(ib(1):ie(1)), & 1119 & start=io_sl(:),count=io_cl(:)) 1120 ENDIF 1121 DEALLOCATE(r4_1d) 1122 CASE (2) !--- 2d array 1123 ALLOCATE(r4_2d(io_n(1),io_n(2))) 1124 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_2d, & 1125 & start=io_i(:),count=io_n(:)) 1126 IF (l_o_f) THEN 1127 ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1; 1128 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1129 & r4_2d(ib(1):ie(1),ib(2):ie(2)), & 1130 & start=io_sf(:),count=io_cf(:)) 1131 ENDIF 1132 ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1; 1133 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1134 & r4_2d(ib(1):ie(1),ib(2):ie(2)), & 1135 & start=io_sm(:),count=io_cm(:)) 1136 IF (l_o_l) THEN 1137 ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1; 1138 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1139 & r4_2d(ib(1):ie(1),ib(2):ie(2)), & 1140 & start=io_sl(:),count=io_cl(:)) 1141 ENDIF 1142 DEALLOCATE(r4_2d) 1143 CASE (3) !--- 3d array 1144 ALLOCATE(r4_3d(io_n(1),io_n(2),io_n(3))) 1145 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_3d, & 1146 & start=io_i(:),count=io_n(:)) 1147 IF (l_o_f) THEN 1148 ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1; 1149 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1150 & r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1151 & start=io_sf(:),count=io_cf(:)) 1152 ENDIF 1153 ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1; 1154 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1155 & r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1156 & start=io_sm(:),count=io_cm(:)) 1157 IF (l_o_l) THEN 1158 ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1; 1159 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1160 & r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1161 & start=io_sl(:),count=io_cl(:)) 1162 ENDIF 1163 DEALLOCATE(r4_3d) 1164 CASE (4) !--- 4d array 1165 ALLOCATE(r4_4d(io_n(1),io_n(2),io_n(3),io_n(4))) 1166 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_4d, & 1167 & start=io_i(:),count=io_n(:)) 1168 IF (l_o_f) THEN 1169 ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1; 1170 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1171 & r4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 1172 & start=io_sf(:),count=io_cf(:)) 1173 ENDIF 1174 ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1; 1175 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1176 & r4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 1177 & start=io_sm(:),count=io_cm(:)) 1178 IF (l_o_l) THEN 1179 ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1; 1180 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1181 & r4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 1182 & start=io_sl(:),count=io_cl(:)) 1183 ENDIF 1184 DEALLOCATE(r4_4d) 1185 CASE (5) !--- 5d array 1186 ALLOCATE(r4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5))) 1187 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_5d, & 1188 & start=io_i(:),count=io_n(:)) 1189 IF (l_o_f) THEN 1190 ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1; 1191 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1192 & r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1193 & ib(4):ie(4),ib(5):ie(5)), & 1194 & start=io_sf(:),count=io_cf(:)) 1195 ENDIF 1196 ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1; 1197 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1198 & r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1199 & ib(4):ie(4),ib(5):ie(5)), & 1200 & start=io_sm(:),count=io_cm(:)) 1201 IF (l_o_l) THEN 1202 ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1; 1203 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1204 & r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1205 & ib(4):ie(4),ib(5):ie(5)), & 1206 & start=io_sl(:),count=io_cl(:)) 1207 ENDIF 1208 DEALLOCATE(r4_5d) 1209 END SELECT 1210 CASE (flio_r8) !--- REAL 8 1211 SELECT CASE (v_d_nb) 1212 CASE (0) !--- Scalar 1213 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_0d) 1214 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r8_0d) 1215 CASE (1) !--- 1d array 1216 ALLOCATE(r8_1d(io_n(1))) 1217 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_1d, & 1218 & start=io_i(:),count=io_n(:)) 1219 IF (l_o_f) THEN 1220 ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1; 1221 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1222 & r8_1d(ib(1):ie(1)), & 1223 & start=io_sf(:),count=io_cf(:)) 1224 ENDIF 1225 ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1; 1226 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1227 & r8_1d(ib(1):ie(1)), & 1228 & start=io_sm(:),count=io_cm(:)) 1229 IF (l_o_l) THEN 1230 ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1; 1231 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1232 & r8_1d(ib(1):ie(1)), & 1233 & start=io_sl(:),count=io_cl(:)) 1234 ENDIF 1235 DEALLOCATE(r8_1d) 1236 CASE (2) !--- 2d array 1237 ALLOCATE(r8_2d(io_n(1),io_n(2))) 1238 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_2d, & 1239 & start=io_i(:),count=io_n(:)) 1240 IF (l_o_f) THEN 1241 ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1; 1242 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1243 & r8_2d(ib(1):ie(1),ib(2):ie(2)), & 1244 & start=io_sf(:),count=io_cf(:)) 1245 ENDIF 1246 ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1; 1247 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1248 & r8_2d(ib(1):ie(1),ib(2):ie(2)), & 1249 & start=io_sm(:),count=io_cm(:)) 1250 IF (l_o_l) THEN 1251 ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1; 1252 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1253 & r8_2d(ib(1):ie(1),ib(2):ie(2)), & 1254 & start=io_sl(:),count=io_cl(:)) 1255 ENDIF 1256 DEALLOCATE(r8_2d) 1257 CASE (3) !--- 3d array 1258 ALLOCATE(r8_3d(io_n(1),io_n(2),io_n(3))) 1259 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_3d, & 1260 & start=io_i(:),count=io_n(:)) 1261 IF (l_o_f) THEN 1262 ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1; 1263 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1264 & r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1265 & start=io_sf(:),count=io_cf(:)) 1266 ENDIF 1267 ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1; 1268 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1269 & r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1270 & start=io_sm(:),count=io_cm(:)) 1271 IF (l_o_l) THEN 1272 ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1; 1273 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1274 & r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), & 1275 & start=io_sl(:),count=io_cl(:)) 1276 ENDIF 1277 DEALLOCATE(r8_3d) 1278 CASE (4) !--- 4d array 1279 ALLOCATE(r8_4d(io_n(1),io_n(2),io_n(3),io_n(4))) 1280 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_4d, & 1281 & start=io_i(:),count=io_n(:)) 1282 IF (l_o_f) THEN 1283 ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1; 1284 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1285 & r8_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 1286 & start=io_sf(:),count=io_cf(:)) 1287 ENDIF 1288 ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1; 1289 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1290 & r8_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 1291 & start=io_sm(:),count=io_cm(:)) 1292 IF (l_o_l) THEN 1293 ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1; 1294 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1295 & r8_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), & 1296 & start=io_sl(:),count=io_cl(:)) 1297 ENDIF 1298 DEALLOCATE(r8_4d) 1299 CASE (5) !--- 5d array 1300 ALLOCATE(r8_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5))) 1301 CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_5d, & 1302 & start=io_i(:),count=io_n(:)) 1303 IF (l_o_f) THEN 1304 ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1; 1305 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1306 & r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1307 & ib(4):ie(4),ib(5):ie(5)), & 1308 & start=io_sf(:),count=io_cf(:)) 1309 ENDIF 1310 ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1; 1311 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1312 & r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1313 & ib(4):ie(4),ib(5):ie(5)), & 1314 & start=io_sm(:),count=io_cm(:)) 1315 IF (l_o_l) THEN 1316 ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1; 1317 CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), & 1318 & r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), & 1319 & ib(4):ie(4),ib(5):ie(5)), & 1320 & start=io_sl(:),count=io_cl(:)) 1321 ENDIF 1322 DEALLOCATE(r8_5d) 1323 END SELECT 1324 END SELECT 1325 !---- 1326 IF (l_ocf.AND.l_cgd.AND.(i_i /= 1)) THEN 1327 !------ close each file containing a small piece of data 1328 CALL flioclo (f_id_i) 1329 ENDIF 1378 ENDIF 1379 ENDDO 1330 1380 ENDDO 1331 !---1332 !-- If needed, deallocate io_* arrays1333 IF (v_d_nb > 0) THEN1334 DEALLOCATE(io_i,io_n,ia_sm,io_sm,io_cm)1335 IF (TRIM(c_d_n) == "apple") THEN1336 DEALLOCATE(ia_sf,io_sf,io_cf)1337 DEALLOCATE(ia_sl,io_sl,io_cl)1338 ENDIF1339 ENDIF1340 1381 ENDDO 1341 1382 !- … … 1345 1386 !- 1346 1387 ! Close files 1347 CALL fl ioclo ()1388 CALL flrb_cf (0,.TRUE.) 1348 1389 !- 1349 1390 ! Deallocate 1350 DEALLOCATE(f_nm) 1351 IF (.NOT.l_ocf) THEN 1352 DEALLOCATE(f_a_id) 1353 ENDIF 1391 DEALLOCATE(f_nm,f_a_id) 1354 1392 DEALLOCATE(f_d_nm,f_v_nm,f_a_nm) 1355 1393 DEALLOCATE(f_d_i,f_d_l) 1394 DEALLOCATE(v_d_nb,v_d_ul,v_type,v_d_i) 1356 1395 DEALLOCATE(d_d_i,d_s_g) 1357 1396 DEALLOCATE(d_s_l,d_p_f,d_p_l,d_h_s,d_h_e) 1358 1397 !- 1359 IF ( l_verbose) THEN1398 IF (i_v_lev >= 1) THEN 1360 1399 !-- elapsed and cpu time computation 1361 1400 CALL cpu_time (t_cpu_end) … … 1367 1406 & t_cpu_end-t_cpu_ini 1368 1407 ENDIF 1408 !======= 1409 CONTAINS 1410 !======= 1411 SUBROUTINE flrb_of (i_f_n,i_f_i) 1412 !--------------------------------------------------------------------- 1413 ! Open the file of number "i_f_n" if necessary, 1414 ! and returns its identifier in "i_f_i". 1415 !--------------------------------------------------------------------- 1416 IMPLICIT NONE 1417 !- 1418 INTEGER,INTENT(IN) :: i_f_n 1419 INTEGER,INTENT(OUT) :: i_f_i 1420 !--------------------------------------------------------------------- 1421 IF (f_a_id(i_f_n) < 0) THEN 1422 CALL flioopfd (TRIM(f_nm(i_f_n)),i_f_i) 1423 f_a_id(i_f_n) = i_f_i 1424 ELSE 1425 i_f_i = f_a_id(i_f_n) 1426 ENDIF 1427 !--------------------- 1428 END SUBROUTINE flrb_of 1429 !=== 1430 SUBROUTINE flrb_cf (i_f_n,l_cf) 1431 !--------------------------------------------------------------------- 1432 ! Close the file of number "i_f_n" if "l_cf" is TRUE. 1433 ! Close all files if "i_f_n <= 0". 1434 !--------------------------------------------------------------------- 1435 IMPLICIT NONE 1436 !- 1437 INTEGER,INTENT(IN) :: i_f_n 1438 LOGICAL,INTENT(IN) :: l_cf 1439 !--------------------------------------------------------------------- 1440 IF (i_f_n <= 0) THEN 1441 CALL flioclo () 1442 f_a_id(:) = -1 1443 ELSE 1444 IF (l_cf) THEN 1445 IF (f_a_id(i_f_n) < 0) THEN 1446 CALL ipslerr (2,"flio_rbld", & 1447 & "The file",TRIM(f_nm(i_f_n)),"is already closed") 1448 ELSE 1449 CALL flioclo (f_a_id(i_f_n)) 1450 f_a_id(i_f_n) = -1 1451 ENDIF 1452 ENDIF 1453 ENDIF 1454 !--------------------- 1455 END SUBROUTINE flrb_cf 1456 !=== 1457 SUBROUTINE flrb_rg 1458 !--------------------------------------------------------------------- 1459 ! Update valid_min valid_max attributes values 1460 !--------------------------------------------------------------------- 1461 INTEGER :: k,j 1462 LOGICAL :: l_vmin,l_vmax 1463 INTEGER(KIND=i_4) :: i4_vmin,i4_vmax 1464 REAL(KIND=r_4) :: r4_vmin,r4_vmax 1465 REAL(KIND=r_8) :: r8_vmin,r8_vmax 1466 !--------------------------------------------------------------------- 1467 DO k=1,f_v_nb 1468 !-- get attribute informations 1469 CALL flioinqa & 1470 & (f_id_i1,TRIM(f_v_nm(k)),'valid_min',l_vmin,a_t=a_type) 1471 CALL flioinqa & 1472 & (f_id_i1,TRIM(f_v_nm(k)),'valid_max',l_vmax,a_t=a_type) 1473 !--- 1474 IF (l_vmin.OR.l_vmax) THEN 1475 !---- get values of min/max 1476 SELECT CASE (a_type) 1477 CASE (flio_i1,flio_i2,flio_i4) !--- INTEGER 1/2/4 1478 DO j=1,f_nb_in 1479 CALL flrb_of (j,f_id_i) 1480 IF (l_vmin) THEN 1481 CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",i4_0d) 1482 IF (j == 1) THEN 1483 i4_vmin = i4_0d 1484 ELSE 1485 i4_vmin = MIN(i4_vmin,i4_0d) 1486 ENDIF 1487 ENDIF 1488 IF (l_vmax) THEN 1489 CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",i4_0d) 1490 IF (j == 1) THEN 1491 i4_vmax = i4_0d 1492 ELSE 1493 i4_vmax = MAX(i4_vmax,i4_0d) 1494 ENDIF 1495 ENDIF 1496 CALL flrb_cf (j,l_ocf) 1497 ENDDO 1498 IF (l_vmin) THEN 1499 CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",i4_vmin) 1500 ENDIF 1501 IF (l_vmax) THEN 1502 CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",i4_vmax) 1503 ENDIF 1504 CASE (flio_r4) !--- REAL 4 1505 DO j=1,f_nb_in 1506 CALL flrb_of (j,f_id_i) 1507 IF (l_vmin) THEN 1508 CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r4_0d) 1509 IF (j == 1) THEN 1510 r4_vmin = r4_0d 1511 ELSE 1512 r4_vmin = MIN(r4_vmin,r4_0d) 1513 ENDIF 1514 ENDIF 1515 IF (l_vmax) THEN 1516 CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r4_0d) 1517 IF (j == 1) THEN 1518 r4_vmax = r4_0d 1519 ELSE 1520 r4_vmax = MAX(r4_vmax,r4_0d) 1521 ENDIF 1522 ENDIF 1523 CALL flrb_cf (j,l_ocf) 1524 ENDDO 1525 IF (l_vmin) THEN 1526 CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r4_vmin) 1527 ENDIF 1528 IF (l_vmax) THEN 1529 CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r4_vmax) 1530 ENDIF 1531 CASE (flio_r8) !--- REAL 8 1532 DO j=1,f_nb_in 1533 CALL flrb_of (j,f_id_i) 1534 IF (l_vmin) THEN 1535 CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r8_0d) 1536 IF (j == 1) THEN 1537 r8_vmin = r8_0d 1538 ELSE 1539 r8_vmin = MIN(r8_vmin,r8_0d) 1540 ENDIF 1541 ENDIF 1542 IF (l_vmax) THEN 1543 CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r8_0d) 1544 IF (j == 1) THEN 1545 r8_vmax = r8_0d 1546 ELSE 1547 r8_vmax = MAX(r8_vmax,r8_0d) 1548 ENDIF 1549 ENDIF 1550 CALL flrb_cf (j,l_ocf) 1551 ENDDO 1552 IF (l_vmin) THEN 1553 CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r8_vmin) 1554 ENDIF 1555 IF (l_vmax) THEN 1556 CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r8_vmax) 1557 ENDIF 1558 END SELECT 1559 ENDIF 1560 ENDDO 1561 !--------------------- 1562 END SUBROUTINE flrb_rg 1563 !=== 1369 1564 !-------------------- 1370 1565 END PROGRAM flio_rbld -
IOIPSL/trunk/tools/rebuild
r82 r257 4 4 # @(#)Rebuild IOIPSL domains 5 5 #--------------------------------------------------------------------- 6 function rebuild_Usage 7 { 8 print - " 9 \"${b_n}\" 10 rebuild a model_file from several input files. 11 Each input file contains the model_data for a domain. 12 13 Usage : 14 ${b_n} [-h] 15 ${b_n} [-v level] [-f] -o output_file_name input_file_names 16 17 Options : 18 -h : help 19 -v O/1/2/3 : verbose mode (verbosity increasing with level) 20 -f : executing mode 21 (execute the program even if the number of input files 22 is not equal to the total number of domains) 23 " 24 } 6 25 #- 7 26 #set -xv 8 27 #- 9 # Extract the calling sequence forthe script (d_n/b_n)28 # Extract the calling sequence of the script (d_n/b_n) 10 29 #- 11 d_n=$ (dirname $0); b_n=$(basename $0);30 d_n=${0%/*}; b_n=${0##*/}; 12 31 #- 13 # Retrieving and validation ofthe options32 # Retrieving the options 14 33 #- 15 r_v=' silencious'; r_f='noforce'; r_o="";16 while getopts :hv fo: V34 r_v='0'; r_f='noforce'; r_o=""; 35 while getopts :hv:fo: V 17 36 do 18 37 case $V in 19 (h) echo ''; 20 echo '"'${b_n}'"'; 21 echo ' rebuild a model_file from several input files.'; 22 echo 'Each input file contains the model_data for a domain.'; 23 echo 'Usage :'; 24 echo ${b_n} '[-h]'; 25 echo ${b_n} '[-v] [-f] -o output_file_name input_file_names'; 26 echo ' -h : this help'; 27 echo ' -v : verbose mode'; 28 echo ' -f : executing mode'; 29 echo ' (execute the program even if the number of input files'; 30 echo ' is not equal to the total number of domains)'; 31 echo ''; 32 exit 0;; 33 (v) r_v='verbose';; 38 (h) rebuild_Usage; exit 0;; 39 (v) r_v=${OPTARG};; 34 40 (f) r_f='force';; 35 41 (o) r_o=${OPTARG};; 36 (:) echo ${b_n}" : option $OPTARG : missing value" 1>&2; 37 exit 2;; 38 (\?) echo ${b_n}" : option $OPTARG : not supported" 1>&2; 39 exit 2;; 42 (:) print -u2 "${b_n} : missing value for option $OPTARG"; exit 2;; 43 (\?) print -u2 "${b_n} : option $OPTARG not supported"; exit 2;; 40 44 esac 41 45 done 42 46 shift $(($OPTIND-1)); 43 47 #- 48 # Validate the -v option 49 #- 50 case ${r_v} in 51 ( 0 | 1 | 2 | 3 );; 52 ("") r_v='0';; 53 (*) 54 print -u2 "${b_n} :"; 55 print -u2 "Invalid verbosity level requested : ${r_v}"; 56 print -u2 "(must be 0, 1, 2 or 3)"; 57 exit 1;; 58 esac 59 #- 44 60 # Validate the number of arguments 45 61 #- 46 if [ ${#} -lt 1 ]; then 47 echo ${b_n}' : Too few arguments have been specified. (Use -h)' 1>&2; 62 [[ ${#} < 1 ]] && \ 63 { 64 print -u2 "${b_n} : Too few arguments have been specified. (Use -h)"; 48 65 exit 3; 49 fi 66 } 50 67 #- 51 68 # Check for the output file name 52 69 #- 53 if [ '\?'${r_o} = '\?' ]; then 54 echo ' ' 1>&2;55 echo ${b_n}' : output_file_name not specified. (Use -h)' 1>&2;56 echo ' "rebuilt_file.nc" should be created.' 1>&2;57 echo ' ' 1>&2;58 r_o='rebuilt_file.nc'59 fi; 70 [[ -z ${r_o} ]] && \ 71 { 72 r_o='rebuilt_file.nc'; 73 print -u2 - " 74 ${b_n} : output_file_name not specified. (Use -h) 75 rebuilt_file.nc should be created." 76 } 60 77 #- 61 78 # Validate the names of the input files 62 79 #- 63 qi=0;64 80 for i in $*; 65 do ((qi=qi+1)); 66 [ ${qi} -le ${#} ] && [ ! -f ${i} ] && \ 67 { echo "${i} unreachable ..."; exit 3;} 81 do 82 [[ ! -f ${i} ]] && { echo "${i} unreachable ..."; exit 3;} 68 83 done 69 84 #- … … 72 87 echo ${r_v} > tmp.$$; 73 88 echo ${r_f} >> tmp.$$; 74 ((qi=$#+1)); 75 echo ${qi} >> tmp.$$; 89 echo $((${#}+1)) >> tmp.$$; 76 90 for i in $*; 77 91 do echo ${i} >> tmp.$$;
Note: See TracChangeset
for help on using the changeset viewer.
