Changeset 2819 for branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

Timestamp:

2011-08-09T10:29:53+02:00 (13 years ago)

Author:

cetlod

Message:

Improvment of branch dev_r2787_LOCEAN3_TRA_TRP

File:

• branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90 (modified) (7 diffs)

branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

@@ -28 +28 @@
    PUBLIC   trc_sms_cfc_alloc   ! called in trcini_cfc.F90
 
-   INTEGER , PUBLIC, PARAMETER ::   jpyear = 150   ! temporal parameter 
    INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres
-   INTEGER , PUBLIC    ::   ndate_beg      ! initial calendar date (aammjj) for CFC
-   INTEGER , PUBLIC    ::   nyear_res      ! restoring time constant (year)
-   INTEGER , PUBLIC    ::   nyear_beg      ! initial year (aa) 
-   INTEGER , PUBLIC    ::   npyear         ! Number of years read in CFC1112 file
+   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file
+   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC
+   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year)
+   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa) 
    
-   REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, 2    )      ::   p_cfc    ! partial hemispheric pressure for CFC
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for CFC
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function
 
    REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm]
@@ -75 +75 @@
       !!                CFC concentration in pico-mol/m3
       !!----------------------------------------------------------------------
-      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
-      USE wrk_nemo, ONLY:   ztrcfc => wrk_3d_1        ! use for CFC sms trend
       !
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
@@ -82 +80 @@
       INTEGER  ::   ji, jj, jn, jl, jm, js
       INTEGER  ::   iyear_beg, iyear_end
-      INTEGER  ::   im1, im2
+      INTEGER  ::   im1, im2, ierr
       REAL(wp) ::   ztap, zdtap        
       REAL(wp) ::   zt1, zt2, zt3, zv2
@@ -90 +88 @@
       REAL(wp) ::   zca_cfc   ! concentration at equilibrium
       REAL(wp) ::   zak_cfc   ! transfert coefficients
-      REAL(wp), DIMENSION(jphem,jp_cfc) ::   zpatm   ! atmospheric function
-      !!----------------------------------------------------------------------
-      !
-      IF( wrk_in_use(3, 1) ) THEN
-         CALL ctl_stop('trc_sms_cfc: requested workspace array unavailable')   ;   RETURN
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)  ::   zpatm     ! atmospheric function
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zpatm(jphem,jp_cfc), STAT=ierr )
+      IF( ierr > 0 ) THEN
+         CALL ctl_stop( 'trc_sms_cfc: unable to allocate zpatm array' )   ;   RETURN
       ENDIF
 
@@ -158 +157 @@
 
                ! Input function  : speed *( conc. at equil - concen at surface )
-               ! trn in pico-mol/l idem qtr; ak in en m/s
+               ! trn in pico-mol/l idem qtr; ak in en m/a
                qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   &
 #if defined key_degrad
@@ -164 +163 @@
 #endif
                   &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )
-
                ! Add the surface flux to the trend
                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1) 
@@ -176 +174 @@
       END DO                                                !  end CFC loop  !
       !                                                     !----------------!
-
-#if defined key_diatrc 
-      ! Save diagnostics , just for CFC11
-# if  defined key_iomput
-      CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) )
-      CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) )
-# else
-      trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1)
-      trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1)
-# endif
-#endif
-
+      IF( ln_diatrc ) THEN
+        !
+        IF( lk_iomput ) THEN
+           CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) )
+           CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) )
+        ELSE
+           trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1)
+           trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1)
+        END IF
+        !
+      END IF
+ 
       IF( l_trdtrc ) THEN
           DO jn = jp_cfc0, jp_cfc1
-            ztrcfc(:,:,:) = tra(:,:,:,jn)
-            CALL trd_mod_trc( ztrcfc, jn, jptra_trd_sms, kt )   ! save trends
+            CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends
           END DO
       END IF
-      !
-      IF( wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_cfc: failed to release workspace array')
       !
    END SUBROUTINE trc_sms_cfc