Changeset 1806 for branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/fldread.F90

Timestamp:

2010-02-24T17:40:02+01:00 (14 years ago)

Author:

cbricaud

Message:

developement that is running with running with nemoref on 19022010

File:

• branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/fldread.F90 (modified) (9 diffs)

branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/fldread.F90

@@ -48 +48 @@
       INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year)
       INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year)
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:)   ::   fnow         ! input fields interpolated to now time step
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) ::   fdta         ! 2 consecutive record of input fields
+      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:)   ::   fnow       ! input fields interpolated to now time step
+      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta       ! 2 consecutive record of input fields
       CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key
                                                         ! into the WGTLIST structure
@@ -120 +120 @@
 
       INTEGER  ::   jf         ! dummy indices
+      INTEGER  ::   jk         ! dummy indices
+      INTEGER  ::   ipk        ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
       INTEGER  ::   kw         ! index into wgts array
       INTEGER  ::   ireclast   ! last record to be read in the current year file
@@ -143 +145 @@
             IF( sd(jf)%ln_tint ) THEN         ! time interpolation: swap before record field
 !CDIR COLLAPSE
-               sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2)
+               sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)
                sd(jf)%rotn(1)     = sd(jf)%rotn(2)
             ENDIF
@@ -204 +206 @@
             IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN
                CALL wgt_list( sd(jf), kw )
-               CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) )
+               ipk = SIZE(sd(jf)%fdta,3)
+               DO jk = 1,ipk
+                  CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , sd(jf)%fdta(:,:,jk,2) , sd(jf)%nrec_a(1) )
+               ENDDO
             ELSE
-               CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) )
+               SELECT CASE( SIZE(sd(jf)%fdta,3) )
+               CASE(1)
+                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) )
+               CASE(jpk)
+                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) )
+               END SELECT
             ENDIF
             sd(jf)%rotn(2) = .FALSE.
@@ -245 +255 @@
                          utmp(:,:) = 0.0
                          vtmp(:,:) = 0.0
-                         CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->i', utmp(:,:) )
-                         CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->j', vtmp(:,:) )
-                         sd(jf)%fdta(:,:,nf) = utmp(:,:)
-                         sd(kf)%fdta(:,:,nf) = vtmp(:,:)
+                         !
+                         ipk = SIZE( sd(kf)%fdta(:,:,:,nf) ,3 )
+                         DO jk = 1,ipk
+                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) )
+                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) )
+                            sd(jf)%fdta(:,:,jk,nf) = utmp(:,:)
+                            sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:)
+                         ENDDO
+                         !
                          sd(jf)%rotn(nf) = .TRUE.
                          sd(kf)%rotn(nf) = .TRUE.
@@ -280 +295 @@
                ztintb =  1. - ztinta
 !CDIR COLLAPSE
-               sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2)
+               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2)
             ELSE
                IF(lwp .AND. kt - nit000 <= 100 ) THEN
@@ -288 +303 @@
                ENDIF
 !CDIR COLLAPSE
-               sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2)   ! piecewise constant field
+               sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2)   ! piecewise constant field
  
             ENDIF
@@ -320 +335 @@
       INTEGER :: inrec          ! number of record existing for this variable
       INTEGER :: kwgt
+      INTEGER :: jk             !vertical loop variable
+      INTEGER :: ipk            !number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
       CHARACTER(LEN=1000) ::   clfmt   ! write format
       !!---------------------------------------------------------------------
@@ -386 +403 @@
          IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
             CALL wgt_list( sdjf, kwgt )
-            CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) )
+            ipk = SIZE(sdjf%fdta,3)
+            DO jk = 1,ipk
+               CALL fld_interp( sdjf%num,sdjf%clvar,kwgt,sdjf%fdta(:,:,jk,2),sdjf%nrec_a(1) )
+            ENDDO
          ELSE
-            CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) )
+            SELECT CASE ( SIZE(sdjf%fdta,3) )
+            CASE(1)
+                CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) )
+            CASE(jpk)
+                if(lwp)write(numout,*)'cbr00 ',sdjf%num,SIZE(sdjf%fdta,3) 
+                CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) )
+            END SELECT
          ENDIF
          sdjf%rotn(2) = .FALSE.