 Timestamp:
 20121127T15:42:24+01:00 (12 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

branches/2012/dev_MERGE_2012/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90
r2281 r3680 678 678 io_sl(v_d_ul(iv))=it 679 679 ENDIF 680 ENDIF 681 ! Initialize to zero variables data 682 ! approximate dimension 683 IF ( it == 1 .AND. l_cgd) THEN 684 ! Enter I*J I*J is larger thant total number of single files 685 if ( ((f_d_l(1)/(d_s_l(1,1)3)) * (f_d_l(2)/(d_s_l(2,1)3) )) .gt. d_n_t ) then 686 CALL ZeroFill (f_id_o, f_v_nm(iv), f_d_l, v_d_nb(iv), v_type(iv), v_d_i(1:v_d_nb(iv),iv)) 687 endif 680 688 ENDIF 681 689 ENDIF … … 1621 1629 END SUBROUTINE flrb_rg 1622 1630 !=== 1631 SUBROUTINE ZeroFill(f_id_o,f_v_nm,f_d_l,v_d_nb,v_type,v_d_i) 1632 1633 IMPLICIT NONE 1634 ! Character length 1635 INTEGER,PARAMETER :: chlen=256 1636 1637 INTEGER :: v_d_nb, v_type ! variable # of dims, variable type, var Unlim dimension 1638 INTEGER :: f_id_o ! Output file ID 1639 INTEGER,DIMENSION(:) :: f_d_l, v_d_i ! Global dimensions, variable dimensio ID 1640 CHARACTER(LEN=chlen) :: f_v_nm ! Variable name 1641 INTEGER,DIMENSION(:),ALLOCATABLE :: dims 1642 1643 INTEGER(KIND=i_2) :: i2_0d 1644 INTEGER(KIND=i_2), ALLOCATABLE :: i2_1d(:), i2_2d(:,:), i2_3d(:,:,:), i2_4d(:,:,:,:), i2_5d(:,:,:,:,:) 1645 INTEGER(KIND=i_4) :: i4_0d 1646 INTEGER(KIND=i_4), ALLOCATABLE :: i4_1d(:), i4_2d(:,:), i4_3d(:,:,:), i4_4d(:,:,:,:), i4_5d(:,:,:,:,:) 1647 REAL(KIND=r_4) :: r4_0d 1648 REAL(KIND=r_4), ALLOCATABLE :: r4_1d(:), r4_2d(:,:), r4_3d(:,:,:), r4_4d(:,:,:,:), r4_5d(:,:,:,:,:) 1649 REAL(KIND=r_8) :: r8_0d 1650 REAL(KIND=r_8), ALLOCATABLE :: r8_1d(:), r8_2d(:,:), r8_3d(:,:,:), r8_4d(:,:,:,:), r8_5d(:,:,:,:,:) 1651 1652 ! write(*,*) ' Into my sub... TOM' 1653 ! write(*,*) f_id_o, TRIM(f_v_nm), v_d_nb , v_type 1654 write(*,*) 'Variable: ',TRIM(f_v_nm), ' intiliazed to zero' 1655 write(*,*) 1656 1657 ! define variable dimension 1658 ALLOCATE(dims(v_d_nb)) 1659 dims=f_d_l(v_d_i) 1660 SELECT CASE(v_type) 1661 ! INTEGER 1 and 2 1662 CASE (flio_i1,flio_i2) 1663 SELECT CASE (v_d_nb) 1664 CASE(1) 1665 ALLOCATE(i2_1d(dims(1))) 1666 i2_1d=0 1667 CALL flioputv (f_id_o,TRIM(f_v_nm),i2_1d) 1668 DEALLOCATE(i2_1d) 1669 CASE(2) 1670 ALLOCATE(i2_2d(dims(1),dims(2))) 1671 i2_2d=0 1672 CALL flioputv (f_id_o,TRIM(f_v_nm),i2_2d) 1673 DEALLOCATE(i2_2d) 1674 CASE(3) 1675 ALLOCATE(i2_3d(dims(1),dims(2),dims(3))) 1676 i2_3d=0 1677 CALL flioputv (f_id_o,TRIM(f_v_nm),i2_3d) 1678 DEALLOCATE(i2_3d) 1679 CASE(4) 1680 ALLOCATE(i2_4d(dims(1),dims(2),dims(3),dims(4))) 1681 i2_4d=0 1682 CALL flioputv (f_id_o,TRIM(f_v_nm),i2_4d) 1683 DEALLOCATE(i2_4d) 1684 CASE(5) 1685 ALLOCATE(i2_5d(dims(1),dims(2),dims(3),dims(4),dims(5))) 1686 i2_5d=0 1687 CALL flioputv (f_id_o,TRIM(f_v_nm),i2_5d) 1688 DEALLOCATE(i2_5d) 1689 END SELECT 1690 ! INTEGER 4 1691 CASE (flio_i4) 1692 SELECT CASE (v_d_nb) 1693 CASE(1) 1694 ALLOCATE(i4_1d(dims(1))) 1695 i4_1d=0 1696 CALL flioputv (f_id_o,TRIM(f_v_nm),i4_1d) 1697 DEALLOCATE(i4_1d) 1698 CASE(2) 1699 ALLOCATE(i4_2d(dims(1),dims(2))) 1700 i4_2d=0 1701 CALL flioputv (f_id_o,TRIM(f_v_nm),i4_2d) 1702 DEALLOCATE(i4_2d) 1703 CASE(3) 1704 ALLOCATE(i4_3d(dims(1),dims(2),dims(3))) 1705 i4_3d=0 1706 CALL flioputv (f_id_o,TRIM(f_v_nm),i4_3d) 1707 DEALLOCATE(i4_3d) 1708 CASE(4) 1709 ALLOCATE(i4_4d(dims(1),dims(2),dims(3),dims(4))) 1710 i4_4d=0 1711 CALL flioputv (f_id_o,TRIM(f_v_nm),i4_4d) 1712 DEALLOCATE(i4_4d) 1713 CASE(5) 1714 ALLOCATE(i4_5d(dims(1),dims(2),dims(3),dims(4),dims(5))) 1715 i4_5d=0 1716 CALL flioputv (f_id_o,TRIM(f_v_nm),i4_5d) 1717 DEALLOCATE(i4_5d) 1718 END SELECT 1719 ! FLOAT 4 1720 CASE (flio_r4) 1721 SELECT CASE (v_d_nb) 1722 CASE(1) 1723 ALLOCATE(r4_1d(dims(1))) 1724 r4_1d=0 1725 CALL flioputv (f_id_o,TRIM(f_v_nm),r4_1d) 1726 DEALLOCATE(r4_1d) 1727 CASE(2) 1728 ALLOCATE(r4_2d(dims(1),dims(2))) 1729 r4_2d=0 1730 CALL flioputv (f_id_o,TRIM(f_v_nm),r4_2d) 1731 DEALLOCATE(r4_2d) 1732 CASE(3) 1733 ALLOCATE(r4_3d(dims(1),dims(2),dims(3))) 1734 r4_3d=0 1735 CALL flioputv (f_id_o,TRIM(f_v_nm),r4_3d) 1736 DEALLOCATE(r4_3d) 1737 CASE(4) 1738 ALLOCATE(r4_4d(dims(1),dims(2),dims(3),dims(4))) 1739 r4_4d=0 1740 CALL flioputv (f_id_o,TRIM(f_v_nm),r4_4d) 1741 DEALLOCATE(r4_4d) 1742 CASE(5) 1743 ALLOCATE(r4_5d(dims(1),dims(2),dims(3),dims(4),dims(5))) 1744 r4_5d=0 1745 CALL flioputv (f_id_o,TRIM(f_v_nm),r4_5d) 1746 DEALLOCATE(r4_5d) 1747 END SELECT 1748 ! FLOAT 8 1749 CASE (flio_r8) 1750 SELECT CASE (v_d_nb) 1751 CASE(1) 1752 ALLOCATE(r8_1d(dims(1))) 1753 r8_1d=0 1754 CALL flioputv (f_id_o,TRIM(f_v_nm),r8_1d) 1755 DEALLOCATE(r8_1d) 1756 CASE(2) 1757 ALLOCATE(r8_2d(dims(1),dims(2))) 1758 r8_2d=0 1759 CALL flioputv (f_id_o,TRIM(f_v_nm),r8_2d) 1760 DEALLOCATE(r8_2d) 1761 CASE(3) 1762 ALLOCATE(r8_3d(dims(1),dims(2),dims(3))) 1763 r8_3d=0 1764 CALL flioputv (f_id_o,TRIM(f_v_nm),r8_3d) 1765 DEALLOCATE(r8_3d) 1766 CASE(4) 1767 ALLOCATE(r8_4d(dims(1),dims(2),dims(3),dims(4))) 1768 r8_4d=0 1769 CALL flioputv (f_id_o,TRIM(f_v_nm),r8_4d) 1770 DEALLOCATE(r8_4d) 1771 CASE(5) 1772 ALLOCATE(r8_5d(dims(1),dims(2),dims(3),dims(4),dims(5))) 1773 r8_5d=0 1774 CALL flioputv (f_id_o,TRIM(f_v_nm),r8_5d) 1775 DEALLOCATE(r8_5d) 1776 END SELECT 1777 END SELECT 1778 1779 DEALLOCATE (dims) 1780 1781 END SUBROUTINE 1782 !=== 1623 1783 ! 1624 1784 END PROGRAM flio_rbld
Note: See TracChangeset
for help on using the changeset viewer.