Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

Timestamp:

2011-03-30T17:58:35+02:00 (13 years ago)

Author:

rblod

Message:

First attempt to put dynamic allocation on the trunk

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90 (modified) (9 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

@@ -28 +28 @@
    PRIVATE
 
-   PUBLIC   sbc_fwb      ! routine called by step
-
-   REAL(wp) ::   a_fwb_b            ! annual domain averaged freshwater budget
-   REAL(wp) ::   a_fwb              ! for 2 year before (_b) and before year.
-   REAL(wp) ::   fwfold             ! fwfold to be suppressed
-   REAL(wp) ::   area               ! global mean ocean surface (interior domain)
-
-   REAL(wp), DIMENSION(jpi,jpj) ::   e1e2    ! area of the interior domain (e1t*e2t)
+   PUBLIC   sbc_fwb    ! routine called by step
+
+   REAL(wp) ::   a_fwb_b   ! annual domain averaged freshwater budget
+   REAL(wp) ::   a_fwb     ! for 2 year before (_b) and before year.
+   REAL(wp) ::   fwfold    ! fwfold to be suppressed
+   REAL(wp) ::   area      ! global mean ocean surface (interior domain)
 
    !! * Substitutions
@@ -60 +58 @@
       !!                   & spread out over erp area depending its sign
       !!----------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   ztmsk_neg      => wrk_2d_1 , ztmsk_pos => wrk_2d_2
+      USE wrk_nemo, ONLY:   ztmsk_tospread => wrk_2d_3
+      USE wrk_nemo, ONLY:   z_wgt          => wrk_2d_4 , zerp_cor  => wrk_2d_5
+      !
       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
       INTEGER, INTENT( in ) ::   kn_fsbc  ! 
       INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index
-      !!
-      INTEGER  ::   inum                  ! temporary logical unit
-      INTEGER  ::   ikty, iyear           ! 
-      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp       ! temporary scalars
-      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread
-      REAL(wp), DIMENSION(jpi,jpj) ::   z_wgt, zerp_cor
+      !
+      INTEGER  ::   inum, ikty, iyear   ! local integers
+      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp   ! local scalars
+      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread    !   -      -
       !!----------------------------------------------------------------------
+      !
+      IF( wrk_in_use(2, 1,2,3,4,5) ) THEN
+         CALL ctl_stop('sbc_fwb: requested workspace arrays are unavailable')   ;   RETURN
+      ENDIF
       !
       IF( kt == nit000 ) THEN
@@ -84 +88 @@
          IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' )
          !
-         e1e2(:,:) = e1t(:,:) * e2t(:,:) 
-         area = glob_sum( e1e2(:,:) )           ! interior global domain surface
+         area = glob_sum( e1e2t(:,:) )           ! interior global domain surface
       ENDIF
       
@@ -94 +97 @@
          !
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            z_fwf = glob_sum( e1e2(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area   ! sum over the global domain
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area   ! sum over the global domain
             emp (:,:) = emp (:,:) - z_fwf 
             emps(:,:) = emps(:,:) - z_fwf 
@@ -117 +120 @@
          IF( MOD( kt, ikty ) == 0 ) THEN
             a_fwb_b = a_fwb
-            a_fwb   = glob_sum( e1e2(:,:) * sshn(:,:) )   ! sum over the global domain
+            a_fwb   = glob_sum( e1e2t(:,:) * sshn(:,:) )   ! sum over the global domain
             a_fwb   = a_fwb * 1.e+3 / ( area * 86400. * 365. )     ! convert in Kg/m3/s = mm/s
 !!gm        !                                                      !!bug 365d year 
@@ -142 +145 @@
             ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
             !
-            zsurf_neg = glob_sum( e1e2(:,:)*ztmsk_neg(:,:) )   ! Area filled by <0 and >0 erp 
-            zsurf_pos = glob_sum( e1e2(:,:)*ztmsk_pos(:,:) )
+            zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )   ! Area filled by <0 and >0 erp 
+            zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )
             !                                                  ! fwf global mean 
-            z_fwf = glob_sum( e1e2(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area
             !            
             IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
@@ -155 +158 @@
             ENDIF
             !
-            zsum_fwf   = glob_sum( e1e2(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area
+            zsum_fwf   = glob_sum( e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area
 !!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so....
             z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall )
             !                                                  ! weight to respect erp field 2D structure 
-            zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2(:,:) )
+            zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )
             z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
             !                                                  ! final correction term to apply
@@ -174 +177 @@
                IF( z_fwf < 0._wp ) THEN
                   WRITE(numout,*)'   z_fwf < 0'
-                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-9,' Sv'
+                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
                ELSE
                   WRITE(numout,*)'   z_fwf >= 0'
-                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-9,' Sv'
+                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
                ENDIF
-               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2(:,:) )*1.e-9,' Sv'
+               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv'
                WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s'
                WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s'
@@ -192 +195 @@
       END SELECT
       !
+      IF( wrk_not_released(2, 1,2,3,4,5) )   CALL ctl_stop('sbc_fwb: failed to release workspace arrays')
+      !
    END SUBROUTINE sbc_fwb