Changeset 6607 for trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

Timestamp:

2016-05-23T17:18:38+02:00 (8 years ago)

Author:

cetlod

Message:

trunk:bugfix on passive tracers restoring ; the previous one was not properly done, see ticket 16677

File:

• trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 (modified) (5 diffs)

trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

@@ -159 +159 @@
 
 
-   SUBROUTINE trc_dta( kt, sf_dta )
+   SUBROUTINE trc_dta( kt, ptrc )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE trc_dta  ***
@@ -169 +169 @@
       !!              - ln_trcdmp=F: deallocates the data structure as they are not used
       !!
-      !! ** Action  :   sf_dta   passive tracer data on medl mesh and interpolated at time-step kt
-      !!----------------------------------------------------------------------
-      INTEGER                     , INTENT(in ) ::   kt     ! ocean time-step
-      TYPE(FLD), DIMENSION(1)   , INTENT(inout) ::   sf_dta     ! array of information on the field to read
+      !! ** Action  :   sf_trcdta   passive tracer data on medl mesh and interpolated at time-step kt
+      !!----------------------------------------------------------------------
+      INTEGER                       , INTENT(in   ) ::   kt     ! ocean time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,nb_trcdta), INTENT(inout) ::   ptrc     ! array of information on the field to read
       !
       INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
       REAL(wp)::   zl, zi
       REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace
-      CHARACTER(len=100) :: clndta
       !!----------------------------------------------------------------------
       !
@@ -184 +183 @@
       IF( nb_trcdta > 0 ) THEN
          !
-         CALL fld_read( kt, 1, sf_dta )      !==   read data at kt time step   ==!
+         CALL fld_read( kt, 1, sf_trcdta )      !==   read data at kt time step   ==!
+         !
+         DO jl = 1, nb_trcdta
+            ptrc(:,:,:,jl) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:)    ! Mask
+         ENDDO
          !
          IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
@@ -192 +195 @@
                WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
             ENDIF
-            !
+            DO jl = 1, nb_trcdta
                DO jj = 1, jpj                         ! vertical interpolation of T & S
                   DO ji = 1, jpi
                      DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
-                        zl = gdept_n(ji,jj,jk)
+                        zl = fsdept_n(ji,jj,jk)
                         IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
-                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,1)
+                           ztp(jk) =  ptrc(ji,jj,1,jl)
                         ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
-                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,jpkm1)
+                           ztp(jk) =  ptrc(ji,jj,jpkm1,jl)
                         ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
                            DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
                               IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
                                  zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
-                                 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - &
-                                           sf_dta(1)%fnow(ji,jj,jkk) ) * zi 
+                                 ztp(jk) = ptrc(ji,jj,jkk,jl) + ( ptrc(ji,jj,jkk+1,jl) - ptrc(ji,jj,jkk,jl) ) * zi 
                               ENDIF
                            END DO
@@ -212 +214 @@
                      END DO
                      DO jk = 1, jpkm1
-                        sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
+                        ptrc(ji,jj,jk,jl) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
                      END DO
-                     sf_dta(1)%fnow(ji,jj,jpk) = 0._wp
+                     ptrc(ji,jj,jpk,jl) = 0._wp
                   END DO
                END DO
+            END DO
             ! 
          ELSE                                !==   z- or zps- coordinate   ==!
             !                             
-               sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask
-               !
-               IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
+            IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
+               DO jl = 1, nb_trcdta
+                  !
                   DO jj = 1, jpj
                      DO ji = 1, jpi
                         ik = mbkt(ji,jj) 
                         IF( ik > 1 ) THEN
-                           zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
-                           sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1)
+                           zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+                           ptrc(ji,jj,ik,jl) = (1.-zl) * ptrc(ji,jj,ik,jl) + zl * ptrc(ji,jj,ik-1,jl)
                         ENDIF
                      END DO
                   END DO
-               ENDIF
+              END DO
+            ENDIF
             !
          ENDIF
          !
       ENDIF
+      ! 
+      IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !== deallocate data structure   ==!
+        !                                                    (data used only for initialisation)
+        IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run'
+        DO jl = 1, nb_trcdta
+                                        DEALLOCATE( sf_trcdta(jl)%fnow)     !  arrays in the structure
+           IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta)
+        ENDDO
+      ENDIF
       !
       IF( nn_timing == 1 )  CALL timing_stop('trc_dta')
       !
    END SUBROUTINE trc_dta
-   
+
 #else
    !!----------------------------------------------------------------------