New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3680 for branches/2012/dev_MERGE_2012/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90 – NEMO

Ignore:
Timestamp:
2012-11-27T15:42:24+01:00 (12 years ago)
Author:
rblod
Message:

First commit of the final branch for 2012 (future nemo_3_5), see ticket #1028

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_MERGE_2012/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90

    r2281 r3680  
    678678              io_sl(v_d_ul(iv))=it 
    679679            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 
    680688          ENDIF 
    681689        ENDIF 
     
    16211629END SUBROUTINE flrb_rg 
    16221630!=== 
     1631SUBROUTINE 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 
     1781END SUBROUTINE 
     1782!=== 
    16231783!-------------------- 
    16241784END PROGRAM flio_rbld 
Note: See TracChangeset for help on using the changeset viewer.