Changeset 3680 for branches/2012/dev_MERGE_2012/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90

Timestamp:

2012-11-27T15:42:24+01:00 (11 years ago)

Author:

rblod

Message:

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

File:

• branches/2012/dev_MERGE_2012/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90 (modified) (2 diffs)

branches/2012/dev_MERGE_2012/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90

@@ -678 +678 @@
               io_sl(v_d_ul(iv))=it
             ENDIF
+          ENDIF
+!-------- Initialize to zero variables data 
+          ! approximate dimension
+          IF ( it == 1 .AND. l_cgd) THEN
+          ! Enter I*J I*J is larger thant total number of single files
+            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 
+              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))
+            endif
           ENDIF
         ENDIF
@@ -1621 +1629 @@
 END SUBROUTINE flrb_rg
 !===
+SUBROUTINE ZeroFill(f_id_o,f_v_nm,f_d_l,v_d_nb,v_type,v_d_i)
+
+  IMPLICIT NONE
+! Character length
+  INTEGER,PARAMETER :: chlen=256
+
+  INTEGER              :: v_d_nb, v_type ! variable # of dims, variable type, var Unlim dimension
+  INTEGER              :: f_id_o         ! Output file ID
+  INTEGER,DIMENSION(:) :: f_d_l, v_d_i    ! Global dimensions, variable dimensio ID
+  CHARACTER(LEN=chlen) :: f_v_nm         ! Variable name
+  INTEGER,DIMENSION(:),ALLOCATABLE :: dims
+
+  INTEGER(KIND=i_2) :: i2_0d
+  INTEGER(KIND=i_2), ALLOCATABLE :: i2_1d(:), i2_2d(:,:), i2_3d(:,:,:), i2_4d(:,:,:,:), i2_5d(:,:,:,:,:)
+  INTEGER(KIND=i_4) :: i4_0d
+  INTEGER(KIND=i_4), ALLOCATABLE :: i4_1d(:), i4_2d(:,:), i4_3d(:,:,:), i4_4d(:,:,:,:), i4_5d(:,:,:,:,:)
+  REAL(KIND=r_4) :: r4_0d
+  REAL(KIND=r_4), ALLOCATABLE    :: r4_1d(:), r4_2d(:,:), r4_3d(:,:,:), r4_4d(:,:,:,:), r4_5d(:,:,:,:,:)
+  REAL(KIND=r_8) :: r8_0d
+  REAL(KIND=r_8), ALLOCATABLE    :: r8_1d(:), r8_2d(:,:), r8_3d(:,:,:), r8_4d(:,:,:,:), r8_5d(:,:,:,:,:)
+  
+  ! write(*,*) ' Into my sub... TOM'
+  ! write(*,*) f_id_o, TRIM(f_v_nm), v_d_nb , v_type
+  write(*,*) 'Variable: ',TRIM(f_v_nm), ' intiliazed to zero'
+  write(*,*)
+
+  ! define variable dimension
+  ALLOCATE(dims(v_d_nb)) 
+  dims=f_d_l(v_d_i)
+  SELECT CASE(v_type) 
+    ! INTEGER 1 and 2 
+    CASE (flio_i1,flio_i2)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(i2_1d(dims(1)))
+         i2_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_1d)
+         DEALLOCATE(i2_1d)
+       CASE(2)
+         ALLOCATE(i2_2d(dims(1),dims(2)))
+         i2_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_2d) 
+         DEALLOCATE(i2_2d)
+       CASE(3)
+         ALLOCATE(i2_3d(dims(1),dims(2),dims(3)))
+         i2_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_3d)
+         DEALLOCATE(i2_3d)
+       CASE(4)
+         ALLOCATE(i2_4d(dims(1),dims(2),dims(3),dims(4)))
+         i2_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_4d)
+         DEALLOCATE(i2_4d)
+       CASE(5)
+         ALLOCATE(i2_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         i2_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_5d)
+         DEALLOCATE(i2_5d)
+      END SELECT
+    ! INTEGER 4
+    CASE (flio_i4)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(i4_1d(dims(1)))
+         i4_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_1d)
+         DEALLOCATE(i4_1d)
+       CASE(2)
+         ALLOCATE(i4_2d(dims(1),dims(2)))
+         i4_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_2d)
+         DEALLOCATE(i4_2d)
+       CASE(3)
+         ALLOCATE(i4_3d(dims(1),dims(2),dims(3)))
+         i4_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_3d)
+         DEALLOCATE(i4_3d)
+       CASE(4)
+         ALLOCATE(i4_4d(dims(1),dims(2),dims(3),dims(4)))
+         i4_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_4d)
+         DEALLOCATE(i4_4d)
+       CASE(5)
+         ALLOCATE(i4_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         i4_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_5d)
+         DEALLOCATE(i4_5d)
+      END SELECT
+    ! FLOAT 4
+    CASE (flio_r4)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(r4_1d(dims(1)))
+         r4_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_1d) 
+         DEALLOCATE(r4_1d)
+       CASE(2)
+         ALLOCATE(r4_2d(dims(1),dims(2)))
+         r4_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_2d) 
+         DEALLOCATE(r4_2d)
+       CASE(3)
+         ALLOCATE(r4_3d(dims(1),dims(2),dims(3)))
+         r4_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_3d) 
+         DEALLOCATE(r4_3d)
+       CASE(4)
+         ALLOCATE(r4_4d(dims(1),dims(2),dims(3),dims(4)))
+         r4_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_4d)
+         DEALLOCATE(r4_4d)
+       CASE(5)
+         ALLOCATE(r4_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         r4_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_5d)
+         DEALLOCATE(r4_5d)
+      END SELECT
+    ! FLOAT 8
+    CASE (flio_r8)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(r8_1d(dims(1)))
+         r8_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_1d)
+         DEALLOCATE(r8_1d)
+       CASE(2)
+         ALLOCATE(r8_2d(dims(1),dims(2)))
+         r8_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_2d) 
+         DEALLOCATE(r8_2d)
+       CASE(3)
+         ALLOCATE(r8_3d(dims(1),dims(2),dims(3)))
+         r8_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_3d)
+         DEALLOCATE(r8_3d)
+       CASE(4)
+         ALLOCATE(r8_4d(dims(1),dims(2),dims(3),dims(4)))
+         r8_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_4d)
+         DEALLOCATE(r8_4d)
+       CASE(5)
+         ALLOCATE(r8_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         r8_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_5d)
+         DEALLOCATE(r8_5d)
+      END SELECT
+  END SELECT
+
+  DEALLOCATE (dims)
+
+END SUBROUTINE
+!===
 !--------------------
 END PROGRAM flio_rbld