Changeset 6164 for branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90

Timestamp:

2015-12-23T18:42:01+01:00 (8 years ago)

Author:

jpalmier

Message:

JPALM -- 23-12-2015 -- 1_ adapt CFC in MEDUSA branch - now Working properly 2_ add diagnostics to Ideal tracer

File:

• branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90 (modified) (4 diffs)

branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90

@@ -25 +25 @@
    PRIVATE
 
-   PUBLIC   trc_sms_idtra       ! called in ???
-
+   PUBLIC   trc_sms_idtra        ! called in ???
+   PUBLIC   trc_sms_idtra_alloc  ! called in ???
+   !
    INTEGER , PUBLIC    ::   nyear_res      ! restoring time constant (year)
    INTEGER , PUBLIC    ::   numnatm
    REAL(wp), PUBLIC    ::   FDEC
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_idtra  ! flux at surface
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_idtra ! cumulative flux 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   inv_idtra  ! vertic. inventory
+
    !                          ! coefficients for conversion
    REAL(wp) ::  WTEMP
@@ -75 +81 @@
 
       !!----------------------------------------------------------------------
-      IF(lwp) WRITE(numout,*) '   - JPALM - verif :'
-      IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~~~~~~~'
-      IF(lwp) WRITE(numout,*) '   - idtra decay factor : ', FDEC
+      IF (kt == nittrc000) THEN
+         IF(lwp) WRITE(numout,*) '   - JPALM - verif :'
+         IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~~~~~~~'
+         IF(lwp) WRITE(numout,*) '   - idtra decay factor : ', FDEC
+      ENDIF
+
+         !
+      inv_idtra(:,:,:) = 0.0                                        !! init the inventory
+      DO jl = 1, jp_idtra
+         jn = jp_idtra0 + jl - 1
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+         !! First, a crude version. will be much inproved later.
+             qtr_idtra(ji,jj,jl)  = (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) *   & 
+                                  fse3t(ji,jj,1) / rdt             !! Air-sea Flux
+           ENDDO
+         ENDDO
+         tra(:,:,1,jn)      = tra(:,:,1,jn) + ( qtr_idtra(:,:,jl) *  &
+                            tmask(:,:,1) / fse3t(:,:,1) )
+         qint_idtra(:,:,jl) = qint_idtra(:,:,jl) +                   &           
+                              qtr_idtra(:,:,jl) * rdt              !! Cumulative Air-sea Flux
 
 
-         !
-DO jn = jp_idtra0, jp_idtra1
-
-        ! DO jj = 1, jpj
-        !    DO ji = 1, jpi
-               ! Surface concentrarion fixed to 1 (ideal tracer concentration unit)
-               trn(:,:,1,jn) = 1.
-               trb(:,:,1,jn) = 1.
-               !
-        !    ENDDO
-        ! ENDDO
-
+         DO jk =1,jpk
+            inv_idtra(:,:,jl) = inv_idtra(:,:,jl) +                  &
+                     (trn(:,:,jk,jn) * fse3t(:,:,jk) * tmask(:,:,jk))  !! vertical inventory
+         ENDDO
 !
 !DECAY of OUR IDEALIZED TRACER
@@ -101 +118 @@
                !  IF (trn(ji,jj,jk,jn) > 0.0) THEN
                     WTEMP = trn(ji,jj,jk,jn) * (1. - FDEC )
-                    tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) - WTEMP/rdt
+                    tra(ji,jj,jk,jn) = (tra(ji,jj,jk,jn) - WTEMP/rdt ) * &
+                                     tmask(ji,jj,jk)
                !  ENDIF 
               ENDDO 
@@ -107 +125 @@
          ENDDO
 
-ENDDO
+      ENDDO
     !! jn loop
 !
 
-!!!!!! No added diagnostics to save here for idealize tracers...
-!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!! #if defined key_trc_diaadd
-!!       ! Save diagnostics , just for TRI111
-!! # if ! defined key_iomput
-!!       trc2d(:,:,jp_idtra0_2d    ) = zpp_idtra(:,:)
-!! # else
-!! !           WRITE(NUMOUT,*) 'Iomput idtrasurf '
-!!       CALL iom_put( "TRISURF"  , zpp_idtra(:,:) )
-!! !      CALL iom_put( "TRISURF"  , xphem(:,:) )
-!! !           WRITE(NUMOUT,*) 'Iomputage '
-!!        CALL iom_put( "AGE"  , zage(:,:,:) )
-!! # endif
-!! #endif
-!!
+        !
+      IF( lrst_trc ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_sms_idtra : cumulated input function fields written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         DO jn = jp_idtra0, jp_idtra1
+            CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,jn) )
+         END DO
+      ENDIF
+      !
+      IF( lk_iomput ) THEN
+         CALL iom_put( "qtrIDTRA"  , qtr_idtra (:,:,1) )
+         CALL iom_put( "qintIDTRA" , qint_idtra(:,:,1) )
+         CALL iom_put( "invIDTRA" , inv_idtra(:,:,1) )
+      ELSE
+         IF( ln_diatrc ) THEN
+            trc2d(:,:,jp_idtra0_2d    ) = qtr_idtra (:,:,1)
+            trc2d(:,:,jp_idtra0_2d + 1) = qint_idtra(:,:,1)
+            trc2d(:,:,jp_idtra0_2d + 2) = inv_idtra(:,:,1)
+         END IF
+      END IF
+      !
+      IF( l_trdtrc ) THEN
+          DO jn = jp_idtra0, jp_idtra1
+            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
+          END DO
+      END IF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_idtra')
+      !
+   END SUBROUTINE trc_sms_idtra
 
-!!      IF( l_trdtrc ) THEN
-!!          DO jn = jp_idtra0, jp_idtra1
-!!            zidtradtra(:,:,:) = tra(:,:,:,jn)
-!!            CALL trd_mod_trc( zidtradtra, jn, jptrc_trd_sms, kt )   ! save trends
-!!          END DO
-!!      END IF
+   INTEGER FUNCTION trc_sms_idtra_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sms_idtra_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( qtr_idtra (jpi,jpj,jp_idtra) ,     &
+         &      inv_idtra(jpi,jpj,jp_idtra)  ,     &
+         &      qint_idtra(jpi,jpj,jp_idtra) , STAT=trc_sms_idtra_alloc )
+         !
+      IF( trc_sms_idtra_alloc /= 0 ) CALL ctl_warn('trc_sms_idtra_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION trc_sms_idtra_alloc
 
-   END SUBROUTINE trc_sms_idtra
 #else
    !!----------------------------------------------------------------------